home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / gnus / gnus.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  279.2 KB  |  7,858 lines

  1. ;;; gnus.el -- GNUS: an NNTP-based News Reader for GNU Emacs
  2. ;; Keywords: news extensions
  3.  
  4. ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994
  5. ;;; Free Software Foundation, Inc.
  6.  
  7. ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
  8. ;; Version: 4.1.3 XEmacs
  9. ;; Derived from: /home/fsf/rms/e19/lisp/RCS/gnus.el,v 1.30 1993/11/17 13:41:50 rms Exp 
  10. ;; Keywords: news
  11.  
  12. ;; This file is part of XEmacs.
  13.  
  14. ;; XEmacs is free software; you can redistribute it and/or modify it
  15. ;; under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation; either version 2, or (at your option)
  17. ;; any later version.
  18.  
  19. ;; XEmacs is distributed in the hope that it will be useful, but
  20. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22. ;; General Public License for more details.
  23.  
  24. ;; You should have received a copy of the GNU General Public License
  25. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  26. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; How to Install GNUS:
  31. ;; (0) First of all, remove GNUS related OLD *.elc files (at least
  32. ;;     nntp.elc).
  33. ;; (1) Unshar gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el, and
  34. ;;     nntp.el.
  35. ;; (2) byte-compile-file nntp.el, gnus.el, gnuspost.el, gnusmail.el,
  36. ;;     and gnusmisc.el.  If you have a local news spool,
  37. ;;     byte-compile-file nnspool.el, too.
  38. ;; (3) Define three environment variables in .login file as follows:
  39. ;;
  40. ;;     setenv    NNTPSERVER    flab
  41. ;;     setenv    DOMAINNAME    "stars.flab.Fujitsu.CO.JP"
  42. ;;     setenv    ORGANIZATION    "Fujitsu Laboratories Ltd., Kawasaki, Japan."
  43. ;;
  44. ;;     Or instead, define lisp variables in your .emacs, site-init.el,
  45. ;;     or default.el as follows:
  46. ;;
  47. ;;     (setq gnus-nntp-server "flab")
  48. ;;     (setq gnus-local-domain "stars.flab.Fujitsu.CO.JP")
  49. ;;     (setq gnus-local-organization "Fujitsu Laboratories Ltd., ...")
  50. ;;
  51. ;;     If the function (system-name) returns the full internet name,
  52. ;;     you don't have to define the domain.
  53. ;;
  54. ;; (4) You may have to define NNTP service name as number 119.
  55. ;;
  56. ;;     (setq gnus-nntp-service 119)
  57. ;;
  58. ;;     Or, if you'd like to use a local news spool directly in stead
  59. ;;     of NNTP, install nnspool.el and set the variable to nil as
  60. ;;     follows:
  61. ;;
  62. ;;     (setq gnus-nntp-service nil)
  63. ;;
  64. ;; (5) If you'd like to use the GENERICFROM feature like the Bnews,
  65. ;;     define the variable as follows:
  66. ;;
  67. ;;     (setq gnus-use-generic-from t)
  68. ;;
  69. ;; (6) Define autoload entries in .emacs file as follows:
  70. ;;
  71. ;;     (autoload 'gnus "gnus" "Read network news." t)
  72. ;;     (autoload 'gnus-post-news "gnuspost" "Post a news." t)
  73. ;;
  74. ;; (7) Read nntp.el if you have problems with NNTP or kanji handling.
  75. ;;
  76. ;; (8) Install mhspool.el, tcp.el, and tcp.c if it is necessary.
  77. ;;
  78. ;;     mhspool.el is a package for reading articles or mail in your
  79. ;;     private directory using GNUS.
  80. ;;
  81. ;;     tcp.el and tcp.c are necessary if and only if your Emacs does
  82. ;;     not have the function `open-network-stream' which is used for
  83. ;;     communicating with NNTP server inside Emacs.
  84. ;;
  85. ;; (9) Install an Info file generated from the texinfo manual gnus.texinfo.
  86. ;;
  87. ;;     If you are not allowed to create the Info file to the standard
  88. ;;     Info-directory, create it in your private directory and set the
  89. ;;     variable gnus-info-directory to that directory.
  90. ;;
  91. ;; For getting more information about GNUS, consult USENET newsgorup
  92. ;; gnu.emacs.gnus.
  93.  
  94. ;; TO DO:
  95. ;; (1) Incremental update of active info.
  96. ;; (2) Asynchronous transmission of large messages.
  97.  
  98. ;;; Code:
  99.  
  100. (provide 'gnus)
  101. (require 'nntp)
  102. (require 'mail-utils)
  103.  
  104. (defvar gnus-default-nntp-server nil
  105.   "*Specify default NNTP server.
  106. This variable should be defined in paths.el.")
  107.  
  108. (defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server)
  109.   "*The name of the host running NNTP server.
  110. If it is a string such as `:DIRECTORY', the user's private DIRECTORY
  111. is used as a news spool.
  112. Initialized from the NNTPSERVER environment variable.")
  113.  
  114. (defvar gnus-nntp-service (purecopy "nntp")
  115.   "*NNTP service name (\"nntp\" or 119).
  116. Go to a local news spool if its value is nil.")
  117.  
  118. (defvar gnus-startup-file (purecopy "~/.newsrc")
  119.   "*Your `.newsrc' file.  Use `.newsrc-SERVER' instead if exists.")
  120.  
  121. (defvar gnus-signature-file (purecopy "~/.signature")
  122.   "*Your `.signature' file.  Use `.signature-DISTRIBUTION' instead if exists.")
  123.  
  124. (defvar gnus-use-cross-reference t
  125.   "*Specifies what to do with cross references (Xref: field).
  126. If nil, ignore cross references.  If t, mark articles as read in
  127. subscribed newsgroups.  Otherwise, if not nil nor t, mark articles as
  128. read in all newsgroups.")
  129.  
  130. (defvar gnus-use-followup-to t
  131.   "*Specifies what to do with Followup-To: field.
  132. If nil, ignore followup-to: field.  If t, use its value except for
  133. `poster'.  Otherwise, if not nil nor t, always use its value.")
  134.  
  135. (defvar gnus-large-newsgroup 50
  136.   "*The number of articles which indicates a large newsgroup.
  137. If the number of articles in a newsgroup is greater than the value,
  138. confirmation is required for selecting the newsgroup.")
  139.  
  140. ;;; XEmacs: gone from nntp.el, but mhspool.el and nnspool.el still use it.
  141. (defvar nntp-large-newsgroup gnus-large-newsgroup)
  142.  
  143. (defvar gnus-author-copy (getenv "AUTHORCOPY")
  144.   "*File name saving a copy of an article posted using FCC: field.
  145. Initialized from the AUTHORCOPY environment variable.
  146.  
  147. Articles are saved using a function specified by the the variable
  148. `gnus-author-copy-saver' (`rmail-output' is default) if a file name is
  149. given.  Instead, if the first character of the name is `|', the
  150. contents of the article is piped out to the named program. It is
  151. possible to save an article in an MH folder as follows:
  152.  
  153. (setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
  154.  
  155. (defvar gnus-author-copy-saver (function rmail-output)
  156.   "*A function called with a file name to save an author copy to.
  157. The default function is `rmail-output' which saves in Unix mailbox format.")
  158.  
  159. (defvar gnus-use-long-file-name
  160.   (not (memq system-type '(usg-unix-v xenix)))
  161.   "*Non-nil means that a newsgroup name is used as a default file name
  162. to save articles to. If it's nil, the directory form of a newsgroup is
  163. used instead.")
  164.  
  165. (defvar gnus-article-save-directory (getenv "SAVEDIR")
  166.   "*A directory name to save articles to (default to ~/News).
  167. Initialized from the SAVEDIR environment variable.")
  168.  
  169. (defvar gnus-default-article-saver (function gnus-summary-save-in-rmail)
  170.   "*A function to save articles in your favorite format.
  171. The function must be interactively callable (in other words, it must
  172. be an Emacs command).
  173.  
  174. GNUS provides the following functions:
  175.     gnus-summary-save-in-rmail (in Rmail format)
  176.     gnus-summary-save-in-mail (in Unix mail format)
  177.     gnus-summary-save-in-folder (in an MH folder)
  178.     gnus-summary-save-in-file (in article format).")
  179.  
  180. (defvar gnus-rmail-save-name (function gnus-plain-save-name)
  181.   "*A function generating a file name to save articles in Rmail format.
  182. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
  183.  
  184. (defvar gnus-mail-save-name (function gnus-plain-save-name)
  185.   "*A function generating a file name to save articles in Unix mail format.
  186. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
  187.  
  188. (defvar gnus-folder-save-name (function gnus-folder-save-name)
  189.   "*A function generating a file name to save articles in MH folder.
  190. The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
  191.  
  192. (defvar gnus-file-save-name (function gnus-numeric-save-name)
  193.   "*A function generating a file name to save articles in article format.
  194. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
  195.  
  196. (defvar gnus-kill-file-name (purecopy "KILL")
  197.   "*File name of a KILL file.")
  198.  
  199. (defvar gnus-novice-user t
  200.   "*Non-nil means that you are a novice to USENET.
  201. If non-nil, verbose messages may be displayed
  202. or your confirmations may be required.")
  203.  
  204. (defvar gnus-interactive-catchup t
  205.   "*Require your confirmation when catching up a newsgroup if non-nil.")
  206.  
  207. (defvar gnus-interactive-post t
  208.   "*Newsgroup, subject, and distribution will be asked for if non-nil.")
  209.  
  210. (defvar gnus-interactive-exit t
  211.   "*Require your confirmation when exiting GNUS if non-nil.")
  212.  
  213. (defvar gnus-user-login-name nil
  214.   "*The login name of the user.
  215. Got from the USER and LOGNAME environment variable if undefined.")
  216.  
  217. (defvar gnus-user-full-name nil
  218.   "*The full name of the user.
  219. Got from the NAME environment variable if undefined.")
  220.  
  221. (defvar gnus-show-mime nil
  222.   "*Show MIME message if non-nil.")
  223.  
  224. (defvar gnus-show-moderated t
  225.   "*Whether to indicate moderated groups in the newsgroup list.")
  226.  
  227. (defvar gnus-show-threads t
  228.   "*Show conversation threads in Summary Mode if non-nil.")
  229.  
  230. ;; XEmacs addition (from Rick Sladkey)
  231. (defvar gnus-show-thread-lines nil
  232.   "*Show thread structure lines in Summary Mode if non-nil.")
  233.  
  234. (defvar gnus-thread-hide-subject t
  235.   "*Non-nil means hide subjects for thread subtrees.")
  236.  
  237. (defvar gnus-thread-hide-subtree nil
  238.   "*Non-nil means hide thread subtrees initially.
  239. If non-nil, you have to run the command `gnus-summary-show-thread' by
  240. hand or by using `gnus-select-article-hook' to show hidden threads.")
  241.  
  242. (defvar gnus-thread-hide-killed t
  243.   "*Non-nil means hide killed thread subtrees automatically.")
  244.  
  245. (defvar gnus-thread-ignore-subject nil
  246.   "*Don't take care of subject differences, but only references if non-nil.
  247. If it is non-nil, some commands work with subjects do not work properly.")
  248.  
  249. (defvar gnus-thread-indent-level 4
  250.   "*Indentation of thread subtrees.")
  251.  
  252. ;; XEmacs change: need to lose all non-[ymn] active file entries.
  253. ;; this was necessary because of the faster imp. of gnus-active-to-gnus-format.
  254. ;; Also nuke newsgroups whose name is all digits - that means that some loser
  255. ;; has let articles get into the root of the news spool, which is toxic.
  256. ;; Also lines beginning with whitespace - also tend to be toxic.
  257. (defvar gnus-ignored-newsgroups
  258.   (purecopy (mapconcat 'identity
  259.                '("^to\\."        ; not "real" groups
  260.              "[ \t][^ymn][^ \t]*$"    ; unrecognised group type
  261.              "^[0-9. \t]+ "        ; all digits in name
  262.              "[][\"#'();\\]"    ; bogus characters
  263.              )
  264.                "\\|"))
  265.   "*A regexp to match uninteresting or invalid newsgroups in the active file.
  266. Any lines in the active file matching this regular expression are
  267. removed from the newsgroup list before anything else is done to it,
  268. thus making them effectively invisible.")
  269.  
  270. (defvar gnus-ignored-headers
  271.   rmail-ignored-headers ; jwz: consolidate this all in one place (loaddefs)
  272. ;;  "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
  273.   "*All random fields within the header of a message.")
  274.  
  275. (defvar gnus-required-headers
  276.   '(From Date Newsgroups Subject Message-ID Organization Lines)
  277.   ;; changed by jwz because it's not so nice to do "Lines: 0" by default.
  278.   ;; changed by jwz to remove Path, since it's incorrect for GNUS to try
  279.   ;; and generate that - it is the responsibility of inews or nntpd.
  280.   ;; Distribution shouldn't be required either.
  281.   "*All required fields for articles you post.
  282. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID
  283. and Path fields.  Organization, Distribution and Lines are optional.
  284. If you want GNUS not to insert some field, remove it from the
  285. variable.")
  286.  
  287. (defvar gnus-show-all-headers nil
  288.   "*Show all headers of an article if non-nil.")
  289.  
  290. (defvar gnus-save-all-headers t
  291.   "*Save all headers of an article if non-nil.")
  292.  
  293. (defvar gnus-optional-headers (function gnus-optional-lines-and-from)
  294.   "*A function generating a optional string displayed in GNUS Summary
  295. mode buffer.  The function is called with an article HEADER. The
  296. result must be a string excluding `[' and `]'.")
  297.  
  298. (defvar gnus-auto-extend-newsgroup t
  299.   "*Extend visible articles to forward and backward if non-nil.")
  300.  
  301. (defvar gnus-auto-select-first t
  302.   "*Select the first unread article automagically if non-nil.
  303. If you want to prevent automatic selection of the first unread article
  304. in some newsgroups, set the variable to nil in `gnus-select-group-hook'
  305. or `gnus-apply-kill-hook'.")
  306.  
  307. (defvar gnus-auto-select-next t
  308.   "*Select the next newsgroup automagically if non-nil.
  309. If the value is t and the next newsgroup is empty, GNUS will exit
  310. Summary mode and go back to Group mode.  If the value is neither nil
  311. nor t, GNUS will select the following unread newsgroup.  Especially, if
  312. the value is the symbol `quietly', the next unread newsgroup will be
  313. selected without any confirmations.")
  314.  
  315. (defvar gnus-auto-select-same nil
  316.   "*Select the next article with the same subject automagically if non-nil.")
  317.  
  318. (defvar gnus-auto-center-summary t
  319.   "*Always center the current summary in GNUS Summary window if non-nil.")
  320.  
  321. (defvar gnus-auto-mail-to-author nil
  322.   "*Insert `To: author' of the article when following up if non-nil.
  323. Mail is sent using the function specified by the variable
  324. `gnus-mail-send-method'.")
  325.  
  326. (defvar gnus-break-pages t
  327.   "*Break an article into pages if non-nil.
  328. Page delimiter is specified by the variable `gnus-page-delimiter'.")
  329.  
  330. (defvar gnus-page-delimiter (purecopy "^\^L")
  331.   "*Regexp describing line-beginnings that separate pages of news article.")
  332.  
  333. (defvar gnus-digest-show-summary t
  334.   "*Show a summary of undigestified messages if non-nil.")
  335.  
  336. (defvar gnus-digest-separator (purecopy "^Subject:[ \t]")
  337.   "*Regexp that separates messages in a digest article.")
  338.  
  339. (defvar gnus-use-full-window t
  340.   "*Non-nil means to take up the entire screen of Emacs.")
  341.  
  342. (defvar gnus-window-configuration
  343.   '((summary (0 1 0))
  344.     (newsgroups   (1 0 0))
  345.     (article   (0 3 10)))
  346.   "*Specify window configurations for each action.
  347. The format of the variable is a list of (ACTION (G S A)), where G, S,
  348. and A are the relative height of Group, Summary, and Article windows,
  349. respectively.  ACTION is `summary', `newsgroups', or `article'.")
  350.  
  351. (defvar gnus-show-mime-method (function metamail-buffer)
  352.   "*Function to process a MIME message.
  353. The function is expected to process current buffer as a MIME message.")
  354.  
  355. (defvar gnus-mail-reply-method
  356.   (function gnus-mail-reply-using-mail)
  357.   "*Function to compose reply mail.
  358. The function `gnus-mail-reply-using-mail' uses usual sendmail mail
  359. program.  The function `gnus-mail-reply-using-mhe' uses the MH-E mail
  360. program.  You can use yet another program by customizing this variable.")
  361.  
  362. (defvar gnus-mail-forward-method
  363.   (function gnus-mail-forward-using-mail)
  364.   "*Function to forward current message to another user.
  365. The function `gnus-mail-reply-using-mail' uses usual sendmail mail
  366. program.  You can use yet another program by customizing this variable.")
  367.  
  368. (defvar gnus-mail-other-window-method
  369.   (function gnus-mail-other-window-using-mail)
  370.   "*Function to compose mail in other window.
  371. The function `gnus-mail-other-window-using-mail' uses the usual sendmail
  372. mail program.  The function `gnus-mail-other-window-using-mhe' uses the MH-E
  373. mail program.  You can use yet another program by customizing this variable.")
  374.  
  375. (defvar gnus-mail-send-method send-mail-function
  376.   "*Function to mail a message too which is being posted as an article.
  377. The message must have To: or Cc: field.  The default is copied from
  378. the variable `send-mail-function'.")
  379.  
  380. (defvar gnus-subscribe-newsgroup-method
  381.   (function gnus-subscribe-alphabetically)
  382.   "*Function called with a newsgroup name when new newsgroup is found.
  383. The function `gnus-subscribe-randomly' inserts a new newsgroup a the
  384. beginning of newsgroups.  The function `gnus-subscribe-alphabetically'
  385. inserts it in strict alphabetic order.  The function
  386. `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup
  387. order.  The function `gnus-subscribe-interactively' asks for your decision.")
  388.  
  389. (defvar gnus-subscribe-default-groups
  390.   (purecopy
  391.    (mapconcat 'identity
  392.           '("^local"
  393.         "\\.newusers"
  394.         "\\.important"
  395.         "^gnu\\.emacs\\.gnus"    ; yeah, well, maybe not...
  396.         )
  397.           "\\b\\|"))
  398.   "*Those newsgroups to which new users should be subscribed by default.")
  399.  
  400. (defvar gnus-group-mode-hook nil
  401.   "*A hook for GNUS Group Mode.")
  402.  
  403. (defvar gnus-summary-mode-hook nil
  404.   "*A hook for GNUS Summary Mode.")
  405.  
  406. (defvar gnus-article-mode-hook nil
  407.   "*A hook for GNUS Article Mode.")
  408.  
  409. (defvar gnus-kill-file-mode-hook nil
  410.   "*A hook for GNUS KILL File Mode.")
  411.  
  412. (defvar gnus-open-server-hook nil
  413.   "*A hook called just before opening connection to news server.")
  414.  
  415. (defvar gnus-startup-hook nil
  416.   "*A hook called at start up time.
  417. This hook is called after GNUS is connected to the NNTP server. So, it
  418. is possible to change the behavior of GNUS according to the selected
  419. NNTP server.")
  420.  
  421. (defvar gnus-group-prepare-hook nil
  422.   "*A hook called after newsgroup list is created in the Newsgroup buffer.
  423. If you want to modify the Newsgroup buffer, you can use this hook.")
  424.  
  425. (defvar gnus-summary-prepare-hook nil
  426.   "*A hook called after summary list is created in the Summary buffer.
  427. If you want to modify the Summary buffer, you can use this hook.")
  428.  
  429. (defvar gnus-article-prepare-hook nil
  430.   "*A hook called after an article is prepared in the Article buffer.
  431. If you want to run a special decoding program like nkf, use this hook.")
  432.  
  433. (defvar gnus-select-group-hook nil
  434.   "*A hook called when a newsgroup is selected.
  435. If you want to sort Summary buffer by date and then by subject, you
  436. can use the following hook:
  437.  
  438. \(setq gnus-select-group-hook
  439.       (list
  440.        (function
  441.     (lambda ()
  442.       ;; First of all, sort by date.
  443.       (gnus-keysort-headers
  444.        (function string-lessp)
  445.        (function
  446.         (lambda (a)
  447.           (gnus-sortable-date (gnus-header-date a)))))
  448.       ;; Then sort by subject string ignoring `Re:'.
  449.       ;; If case-fold-search is non-nil, case of letters is ignored.
  450.       (gnus-keysort-headers
  451.        (function string-lessp)
  452.        (function
  453.         (lambda (a)
  454.           (if case-fold-search
  455.           (downcase (gnus-simplify-subject (gnus-header-subject a) t))
  456.         (gnus-simplify-subject (gnus-header-subject a) t)))))
  457.       ))))
  458.  
  459. If you'd like to simplify subjects like the
  460. `gnus-summary-next-same-subject' command does, you can use the
  461. following hook:
  462.  
  463. \(setq gnus-select-group-hook
  464.       (list
  465.        (function
  466.     (lambda ()
  467.       (mapcar (function
  468.            (lambda (header)
  469.              (nntp-set-header-subject
  470.               header
  471.               (gnus-simplify-subject
  472.                (gnus-header-subject header) 're-only))))
  473.           gnus-newsgroup-headers)))))
  474.  
  475. In some newsgroups author name is meaningless. It is possible to
  476. prevent listing author names in GNUS Summary buffer as follows:
  477.  
  478. \(setq gnus-select-group-hook
  479.       (list
  480.        (function
  481.     (lambda ()
  482.       (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name)
  483.          (setq gnus-optional-headers
  484.                (function gnus-optional-lines)))
  485.         (t
  486.          (setq gnus-optional-headers
  487.                (function gnus-optional-lines-and-from))))))))")
  488.  
  489. (defvar gnus-select-article-hook
  490.   '(gnus-summary-show-thread)
  491.   "*A hook called when an article is selected.
  492. The default hook shows conversation thread subtrees of the selected
  493. article automatically using `gnus-summary-show-thread'.
  494.  
  495. If you'd like to run RMAIL on a digest article automagically, you can
  496. use the following hook:
  497.  
  498. \(setq gnus-select-article-hook
  499.       (list
  500.        (function
  501.     (lambda ()
  502.       (gnus-summary-show-thread)
  503.       (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
  504.          (gnus-summary-rmail-digest))
  505.         ((and (string-equal \"comp.text\" gnus-newsgroup-name)
  506.               (string-match \"^TeXhax Digest\"
  507.                     (gnus-header-subject gnus-current-headers)))
  508.          (gnus-summary-rmail-digest)
  509.          ))))))")
  510.  
  511. (defvar gnus-select-digest-hook
  512.   (list
  513.    (function
  514.     (lambda ()
  515.       ;; Reply-To: is required by `undigestify-rmail-message'.
  516.       (or (mail-position-on-field "Reply-to" t)
  517.       (progn
  518.         (mail-position-on-field "Reply-to")
  519.         (insert (gnus-fetch-field "From")))))))
  520.   "*A hook called when reading digest messages using Rmail.
  521. This hook can be used to modify incomplete digest articles as follows
  522. \(this is the default):
  523.  
  524. \(setq gnus-select-digest-hook
  525.       (list
  526.        (function
  527.     (lambda ()
  528.       ;; Reply-To: is required by `undigestify-rmail-message'.
  529.       (or (mail-position-on-field \"Reply-to\" t)
  530.           (progn
  531.         (mail-position-on-field \"Reply-to\")
  532.         (insert (gnus-fetch-field \"From\"))))))))")
  533.  
  534. (defvar gnus-rmail-digest-hook nil
  535.   "*A hook called when reading digest messages using Rmail.
  536. This hook is intended to customize Rmail mode for reading digest articles.")
  537.  
  538. (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
  539.   "*A hook called when a newsgroup is selected and summary list is prepared.
  540. This hook is intended to apply a KILL file to the selected newsgroup.
  541. The function `gnus-apply-kill-file' is called by default.
  542.  
  543. Since a general KILL file is too heavy to use only for a few
  544. newsgroups, I recommend you to use a lighter hook function. For
  545. example, if you'd like to apply a KILL file to articles which contains
  546. a string `rmgroup' in subject in newsgroup `control', you can use the
  547. following hook:
  548.  
  549. \(setq gnus-apply-kill-hook
  550.       (list
  551.        (function
  552.     (lambda ()
  553.       (cond ((string-match \"control\" gnus-newsgroup-name)
  554.          (gnus-kill \"Subject\" \"rmgroup\")
  555.          (gnus-expunge \"X\")))))))")
  556.  
  557. (defvar gnus-mark-article-hook
  558.   (list
  559.    (function
  560.     (lambda ()
  561.       (or (memq gnus-current-article gnus-newsgroup-marked)
  562.       (gnus-summary-mark-as-read gnus-current-article))
  563.       (gnus-summary-set-current-mark "+"))))
  564.   "*A hook called when an article is selected at the first time.
  565. The hook is intended to mark an article as read (or unread)
  566. automatically when it is selected.
  567.  
  568. If you'd like to mark as unread (-) instead, use the following hook:
  569.  
  570. \(setq gnus-mark-article-hook
  571.       (list
  572.        (function
  573.         (lambda ()
  574.       (gnus-summary-mark-as-unread gnus-current-article)
  575.       (gnus-summary-set-current-mark \"+\")))))")
  576.  
  577. (defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature))
  578.   "*A hook called after preparing body, but before preparing header fields.
  579. The default hook (`gnus-inews-insert-signature') inserts a signature
  580. file specified by the variable `gnus-signature-file'.")
  581.  
  582. (defvar gnus-inews-article-hook (list (function gnus-inews-do-fcc))
  583.   "*A hook called before finally posting an article.
  584. The default hook (`gnus-inews-do-fcc') does FCC processing (save article
  585. to a file).")
  586.  
  587. (defvar gnus-exit-group-hook nil
  588.   "*A hook called when exiting (not quitting) Summary mode.
  589. If your machine is so slow that exiting from Summary mode takes very
  590. long time, set the variable `gnus-use-cross-reference' to nil. This
  591. inhibits marking articles as read using cross-reference information.")
  592.  
  593. (defvar gnus-suspend-gnus-hook nil
  594.   "*A hook called when suspending (not exiting) GNUS.")
  595.  
  596. (defvar gnus-exit-gnus-hook nil
  597.   "*A hook called when exiting (not suspending) GNUS.")
  598.  
  599. (defvar gnus-save-newsrc-hook nil
  600.   "*A hook called when saving the newsrc file.
  601. This hook is called before saving the `.newsrc' file.")
  602.  
  603.  
  604. ;; Site dependent variables. You have to define these variables in
  605. ;;  site-init.el, default.el or your .emacs.
  606.  
  607. (defvar gnus-local-timezone nil
  608.   "*Local time zone.
  609. This value is used only if `current-time-zone' does not work in your Emacs.
  610. It specifies the GMT offset, i.e. a decimal integer
  611. of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT.
  612. For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT.
  613.  
  614. For backwards compatibility, it may also be a string like \"JST\",
  615. but strings are obsolescent: you should use numeric offsets instead.")
  616.  
  617. (defvar gnus-local-domain nil
  618.   "*Local domain name without a host name like: \"stars.flab.Fujitsu.CO.JP\"
  619. The `DOMAINNAME' environment variable is used instead if defined.  If
  620. the function (system-name) returns the full internet name, there is no
  621. need to define the name.")
  622.  
  623. (defvar gnus-local-organization nil
  624.   "*Local organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\"
  625. The `ORGANIZATION' environment variable is used instead if defined.")
  626.  
  627. ;; XEmacs change
  628. ;;; jwz: changed "world" to come first: the default should be to let people
  629. ;;; post to the net.  It's too easy for people to not notice that the default
  630. ;;; caused their message to get dropped in the bit-bucket!!
  631. (defvar gnus-local-distributions (list (purecopy "world") (purecopy "local"))
  632.   "*List of distributions.
  633. The first element in the list is used as default.  If distributions
  634. file is available, its content is also used.")
  635.  
  636. (defvar gnus-use-generic-from nil
  637.   "*If nil, prepend local host name to the defined domain in the From:
  638. field; if stringp, use this; if non-nil, strip of the local host name.")
  639.  
  640. (defvar gnus-use-generic-path nil
  641.   "*If nil, use the NNTP server name in the Path: field; if stringp,
  642. use this; if non-nil, use no host name (user name only)")
  643.  
  644. ;; Internal variables.
  645.  
  646. (defconst gnus-version (purecopy "GNUS 4.1.3 XEmacs")
  647.   "Version numbers of this version of GNUS.")
  648.  
  649. ;; XEmacs change: this is no longer needed (it was for regexp lossage.)
  650. ;(defconst gnus-emacs-version
  651. ;  (progn
  652. ;    (string-match "[0-9]*" emacs-version)
  653. ;    (string-to-int (substring emacs-version
  654. ;                  (match-beginning 0) (match-end 0))))
  655. ;  "Major version number of this emacs.")
  656.  
  657. (defvar gnus-info-nodes
  658.   (purecopy
  659.    '((gnus-group-mode        "(gnus)Newsgroup Commands")
  660.      (gnus-summary-mode        "(gnus)Summary Commands")
  661.      (gnus-article-mode        "(gnus)Article Commands")
  662.      (gnus-kill-file-mode    "(gnus)Kill File")
  663.      (gnus-browse-killed-mode    "(gnus)Maintaining Subscriptions")))
  664.   "Assoc list of major modes and related Info nodes.")
  665.  
  666. ;; Alist syntax is different from that of 3.14.3.
  667. ;; XEmacs: added more code around gnus-retrieve-headers, gnus-request-article.
  668. ;; XEmacs: added gnus-retrieve-headers-by-id; the contract is now that the
  669. ;; *-retrieve-headers methods will only be called with article numbers, and
  670. ;; the *-retrieve-headers-by-id methods will be called with message IDs.
  671. (defvar gnus-access-methods
  672.   (purecopy
  673.   '((nntp
  674.      (gnus-retrieve-headers-1        nntp-retrieve-headers)
  675.      (gnus-retrieve-headers-by-id    nntp-retrieve-headers-by-id)
  676.      (gnus-open-server            nntp-open-server)
  677.      (gnus-close-server            nntp-close-server)
  678.      (gnus-server-opened        nntp-server-opened)
  679.      (gnus-status-message        nntp-status-message)
  680.      (gnus-request-article-1        nntp-request-article)
  681.      (gnus-request-group        nntp-request-group)
  682.      (gnus-request-list            nntp-request-list)
  683.      (gnus-request-list-newsgroups    nntp-request-list-newsgroups)
  684.      (gnus-request-list-distributions    nntp-request-list-distributions)
  685.      (gnus-request-post            nntp-request-post))
  686.     (nnspool
  687.      (gnus-retrieve-headers-1        nnspool-retrieve-headers)
  688.      (gnus-retrieve-headers-by-id    nnspool-retrieve-headers-by-id)
  689.      (gnus-open-server            nnspool-open-server)
  690.      (gnus-close-server            nnspool-close-server)
  691.      (gnus-server-opened        nnspool-server-opened)
  692.      (gnus-status-message        nnspool-status-message)
  693.      (gnus-request-article-1        nnspool-request-article)
  694.      (gnus-request-group        nnspool-request-group)
  695.      (gnus-request-list            nnspool-request-list)
  696.      (gnus-request-list-newsgroups    nnspool-request-list-newsgroups)
  697.      (gnus-request-list-distributions    nnspool-request-list-distributions)
  698.      (gnus-request-post            nnspool-request-post))
  699.     (mhspool
  700.      (gnus-retrieve-headers-1        mhspool-retrieve-headers)
  701.      (gnus-retrieve-headers-by-id    mhspool-retrieve-headers-by-id)
  702.      (gnus-open-server            mhspool-open-server)
  703.      (gnus-close-server            mhspool-close-server)
  704.      (gnus-server-opened        mhspool-server-opened)
  705.      (gnus-status-message        mhspool-status-message)
  706.      (gnus-request-article-1        mhspool-request-article)
  707.      (gnus-request-group        mhspool-request-group)
  708.      (gnus-request-list            mhspool-request-list)
  709.      (gnus-request-list-newsgroups    mhspool-request-list-newsgroups)
  710.      (gnus-request-list-distributions    mhspool-request-list-distributions)
  711.      (gnus-request-post            mhspool-request-post))))
  712.   "Access method for NNTP, nnspool, and mhspool.")
  713.  
  714. (defvar gnus-group-buffer (purecopy "*Newsgroup*"))
  715. (defvar gnus-summary-buffer (purecopy "*Summary*"))
  716. (defvar gnus-article-buffer (purecopy "*Article*"))
  717. (defvar gnus-digest-buffer (purecopy "GNUS Digest"))
  718. (defvar gnus-digest-summary-buffer (purecopy "GNUS Digest-summary"))
  719.  
  720. (defvar gnus-buffer-list
  721.   (list gnus-group-buffer gnus-summary-buffer gnus-article-buffer
  722.     gnus-digest-buffer gnus-digest-summary-buffer)
  723.   "GNUS buffer names which should be killed when exiting.")
  724.  
  725. (defvar gnus-variable-list
  726.   '(gnus-newsrc-options
  727.     gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
  728.     gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)
  729.   "GNUS variables saved in the quick startup file.")
  730.  
  731. (defvar gnus-overload-functions
  732.   (purecopy
  733.    '((news-inews gnus-inews-news "rnewspost")
  734.      (caesar-region gnus-caesar-region "rnews")))
  735.   "Functions overloaded by gnus.
  736. It is a list of `(original overload &optional file)'.")
  737.  
  738. (defvar gnus-distribution-list nil)
  739.  
  740. (defvar gnus-newsrc-options nil
  741.   "Options line in the .newsrc file.")
  742.  
  743. (defvar gnus-newsrc-options-n-yes nil
  744.   "Regexp representing subscribed newsgroups.")
  745.  
  746. (defvar gnus-newsrc-options-n-no nil
  747.   "Regexp representing unsubscribed newsgroups.")
  748.  
  749. (defvar gnus-newsrc-assoc nil
  750.   "Assoc list of read articles.
  751. gnus-newsrc-hashtb should be kept so that both hold the same information.")
  752.  
  753. (defvar gnus-newsrc-hashtb nil
  754.   "Hashtable of gnus-newsrc-assoc.")
  755.  
  756. (defvar gnus-killed-assoc nil
  757.   "Assoc list of newsgroups removed from gnus-newsrc-assoc.
  758. gnus-killed-hashtb should be kept so that both hold the same information.")
  759.  
  760. (defvar gnus-killed-hashtb nil
  761.   "Hashtable of gnus-killed-assoc.")
  762.  
  763. (defvar gnus-marked-assoc nil
  764.   "Assoc list of articles marked as unread.
  765. gnus-marked-hashtb should be kept so that both hold the same information.")
  766.  
  767. (defvar gnus-marked-hashtb nil
  768.   "Hashtable of gnus-marked-assoc.")
  769.  
  770. (defvar gnus-unread-hashtb nil
  771.   "Hashtable of unread articles.")
  772.  
  773. (defvar gnus-active-hashtb nil
  774.   "Hashtable of active articles.")
  775.  
  776. (defvar gnus-octive-hashtb nil
  777.   "Hashtable of OLD active articles.")
  778.  
  779. (defvar gnus-current-startup-file nil
  780.   "Startup file for the current host.")
  781.  
  782. (defvar gnus-last-search-regexp nil
  783.   "Default regexp for article search command.")
  784.  
  785. (defvar gnus-last-shell-command nil
  786.   "Default shell command on article.")
  787.  
  788. (defvar gnus-have-all-newsgroups nil)
  789.  
  790. (defvar gnus-newsgroup-name nil)
  791. (defvar gnus-newsgroup-begin nil)
  792. (defvar gnus-newsgroup-end nil)
  793. (defvar gnus-newsgroup-last-rmail nil)
  794. (defvar gnus-newsgroup-last-mail nil)
  795. (defvar gnus-newsgroup-last-folder nil)
  796. (defvar gnus-newsgroup-last-file nil)
  797.  
  798. (defvar gnus-newsgroup-unreads nil
  799.   "List of unread articles in the current newsgroup.")
  800.  
  801. (defvar gnus-newsgroup-unselected nil
  802.   "List of unselected unread articles in the current newsgroup.")
  803.  
  804. (defvar gnus-newsgroup-marked nil
  805.   "List of marked articles in the current newsgroup (a subset of unread art).")
  806.  
  807. (defvar gnus-newsgroup-headers nil
  808.   "List of article headers in the current newsgroup.
  809. If the variable is modified (added or deleted), the function
  810. gnus-clear-hashtables-for-newsgroup-headers must be called to clear
  811. the hash tables.")
  812. (defvar gnus-newsgroup-headers-hashtb-by-id nil)
  813. (defvar gnus-newsgroup-headers-hashtb-by-number nil)
  814.  
  815. (defvar gnus-current-article nil)
  816. (defvar gnus-current-headers nil)
  817. (defvar gnus-current-history nil)
  818. (defvar gnus-have-all-headers nil "Must be either T or NIL.")
  819. (defvar gnus-last-article nil)
  820. (defvar gnus-current-kill-article nil)
  821.  
  822. ;; Save window configuration.
  823. (defvar gnus-winconf-kill-file nil)
  824.  
  825. (defvar gnus-group-mode-map nil)
  826. (defvar gnus-summary-mode-map nil)
  827. (defvar gnus-article-mode-map nil)
  828. (defvar gnus-kill-file-mode-map nil)
  829.  
  830. (defvar rmail-last-file (expand-file-name "~/XMBOX"))
  831. (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
  832.  
  833. ;; Define GNUS Subsystems.
  834. (autoload 'gnus-group-post-news "gnuspost"
  835.       "Post an article." t)
  836. (autoload 'gnus-summary-post-news "gnuspost"
  837.       "Post an article." t)
  838. (autoload 'gnus-summary-followup "gnuspost"
  839.       "Post a reply article." t)
  840. (autoload 'gnus-summary-followup-with-original "gnuspost"
  841.       "Post a reply article with original article." t)
  842. (autoload 'gnus-summary-cancel-article "gnuspost"
  843.       "Cancel an article you posted." t)
  844. ;; XEmacs change; this way of doing digest is more better
  845. (autoload 'gnus-summary-read-digest "gnus-digest"
  846.        "Expand the current message as a digest" t)
  847.  
  848. (autoload 'gnus-summary-reply "gnusmail"
  849.       "Reply mail to news author." t)
  850. (autoload 'gnus-summary-reply-with-original "gnusmail"
  851.       "Reply mail to news author with original article." t)
  852. (autoload 'gnus-summary-mail-forward "gnusmail"
  853.       "Forward the current message to another user." t)
  854. (autoload 'gnus-summary-mail-other-window "gnusmail"
  855.       "Compose mail in other window." t)
  856.  
  857. (autoload 'gnus-group-kill-group "gnusmisc"
  858.       "Kill newsgroup on current line." t)
  859. (autoload 'gnus-group-yank-group "gnusmisc"
  860.       "Yank the last killed newsgroup on current line." t)
  861. (autoload 'gnus-group-kill-region "gnusmisc"
  862.       "Kill newsgroups in current region." t)
  863. (autoload 'gnus-group-transpose-groups "gnusmisc"
  864.       "Exchange current newsgroup and previous newsgroup." t)
  865. (autoload 'gnus-list-killed-groups "gnusmisc"
  866.       "List the killed newsgroups." t)
  867. (autoload 'gnus-gmt-to-local "gnusmisc"
  868.       "Rewrite Date field in GMT to local in current buffer.")
  869.  
  870. (autoload 'metamail-buffer "metamail"
  871.       "Process current buffer through 'metamail'." t)
  872.  
  873. (autoload 'timezone-make-sortable-date "timezone")
  874. (autoload 'timezone-parse-date "timezone")
  875.  
  876. (autoload 'rmail-output "rmailout"
  877.       "Append this message to Unix mail file named FILE-NAME." t)
  878. (autoload 'rmail-file-p "rmailout" "Check if this is an rmail file" t)
  879. (autoload 'mail-position-on-field "sendmail")
  880. (autoload 'mh-find-path "mh-e")
  881. (autoload 'mh-prompt-for-folder "mh-e")
  882.  
  883. (put 'gnus-group-mode 'mode-class 'special)
  884. (put 'gnus-summary-mode 'mode-class 'special)
  885. (put 'gnus-article-mode 'mode-class 'special)
  886.  
  887.  
  888. ;;(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
  889.  
  890. ;; XEmacs change; using pop-to-buffer directly loses with auto new-screen.
  891. (defun gnus-pop-to-buffer (buffer)
  892.   (let ((pre-display-buffer-function nil)) ; don't use a new screen in XEmacs
  893.     (pop-to-buffer buffer)))
  894.  
  895. (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
  896.   "Pop to BUFFER, evaluate FORMS, and then returns to original window."
  897.   (` (let ((GNUSStartBufferWindow (selected-window)))
  898.        (unwind-protect
  899.        (progn
  900.          (gnus-pop-to-buffer (, buffer))
  901.          (,@ forms))
  902.      (select-window GNUSStartBufferWindow)))))
  903.  
  904. ;; These are prime; they are the sizes of which we make the hash tables.
  905. (defconst gnus-primes
  906.   (purecopy
  907.    '(13 29 37 47 59 71 89 107 131 163 197 239 293 353 431 521 631 761 919 1103
  908.      1327 1597 1931 2333 2801 3371 4049 4861 5839 7013 8419 10103 12143 14591
  909.      17519 21023 25229 30293 36353 43627 52361 62851 75431 90523 108631 130363
  910.      156437 187751 225307 270371 324449 389357 467237 560689 672827 807403
  911.      968897 1162687 1395263 1674319 2009191 2411033 2893249)))
  912.  
  913. (defun gnus-make-hashtable (&optional hashsize)
  914.   "Make a hash table (default and minimum size is around 200).
  915. Optional argument HASHSIZE specifies the table size."
  916.   (if (or (null hashsize) (< hashsize 200))
  917.       (setq hashsize 200))
  918.   (let ((sizes gnus-primes))
  919.     (while (> hashsize (car sizes))
  920.       (setq sizes (cdr sizes)))
  921.     (make-vector (car sizes) 0)))
  922.  
  923. (defmacro gnus-gethash (string hashtable)
  924.   "Get hash value of STRING in HASHTABLE."
  925.   ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
  926.   ;;(` (abbrev-expansion (, string) (, hashtable)))
  927.   (` (symbol-value (intern-soft (, string) (, hashtable)))))
  928.  
  929. (defmacro gnus-sethash (string value hashtable)
  930.   "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
  931.   ;; We cannot use define-abbrev since it only accepts string as value.
  932.   (` (set (intern (, string) (, hashtable)) (, value))))
  933.  
  934. ;; XEmacs change
  935. (defvar gnus-lazy-message-time 0)
  936. (defun gnus-lazy-message (&rest args)
  937.   "Just like `message' but is a no-op if called more than once a second."
  938.   (if (= gnus-lazy-message-time
  939.      (setq gnus-lazy-message-time (nth 1 (current-time))))
  940.       nil
  941.     (apply 'message args)))
  942.  
  943. (or (fboundp 'current-time) (fset 'gnus-lazy-message 'message))
  944.  
  945.  
  946. ;; Note: Macros defined here are also defined in nntp.el. I don't like
  947. ;; to put them here, but many users got troubled with the old
  948. ;; definitions in nntp.elc. These codes are NNTP 3.10 version.
  949.  
  950. (defmacro nntp-header-number (header)
  951.   "Return article number in HEADER."
  952.   (` (aref (, header) 0)))
  953.  
  954. (defmacro nntp-set-header-number (header number)
  955.   "Set article number of HEADER to NUMBER."
  956.   (` (aset (, header) 0 (, number))))
  957.  
  958. (defmacro nntp-header-subject (header)
  959.   "Return subject string in HEADER."
  960.   (` (aref (, header) 1)))
  961.  
  962. (defmacro nntp-set-header-subject (header subject)
  963.   "Set article subject of HEADER to SUBJECT."
  964.   (` (aset (, header) 1 (, subject))))
  965.  
  966. (defmacro nntp-header-from (header)
  967.   "Return author string in HEADER."
  968.   (` (aref (, header) 2)))
  969.  
  970. (defmacro nntp-set-header-from (header from)
  971.   "Set article author of HEADER to FROM."
  972.   (` (aset (, header) 2 (, from))))
  973.  
  974. (defmacro nntp-header-xref (header)
  975.   "Return xref string in HEADER."
  976.   (` (aref (, header) 3)))
  977.  
  978. (defmacro nntp-set-header-xref (header xref)
  979.   "Set article xref of HEADER to xref."
  980.   (` (aset (, header) 3 (, xref))))
  981.  
  982. (defmacro nntp-header-lines (header)
  983.   "Return lines in HEADER."
  984.   (` (aref (, header) 4)))
  985.  
  986. (defmacro nntp-set-header-lines (header lines)
  987.   "Set article lines of HEADER to LINES."
  988.   (` (aset (, header) 4 (, lines))))
  989.  
  990. (defmacro nntp-header-date (header)
  991.   "Return date in HEADER."
  992.   (` (aref (, header) 5)))
  993.  
  994. (defmacro nntp-set-header-date (header date)
  995.   "Set article date of HEADER to DATE."
  996.   (` (aset (, header) 5 (, date))))
  997.  
  998. (defmacro nntp-header-id (header)
  999.   "Return Id in HEADER."
  1000.   (` (aref (, header) 6)))
  1001.  
  1002. (defmacro nntp-set-header-id (header id)
  1003.   "Set article Id of HEADER to ID."
  1004.   (` (aset (, header) 6 (, id))))
  1005.  
  1006. (defmacro nntp-header-references (header)
  1007.   "Return references in HEADER."
  1008.   (` (aref (, header) 7)))
  1009.  
  1010. (defmacro nntp-set-header-references (header ref)
  1011.   "Set article references of HEADER to REF."
  1012.   (` (aset (, header) 7 (, ref))))
  1013.  
  1014.  
  1015. ;;;
  1016. ;;; GNUS Group Mode
  1017. ;;;
  1018.  
  1019. (if gnus-group-mode-map
  1020.     nil
  1021.   (setq gnus-group-mode-map (make-keymap))
  1022.   (suppress-keymap gnus-group-mode-map)
  1023.   (define-key gnus-group-mode-map " " 'gnus-group-read-group)
  1024.   (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
  1025.   (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
  1026.   (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
  1027.   (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
  1028.   (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
  1029.   (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
  1030.   (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
  1031.   (define-key gnus-group-mode-map "\C-n" 'gnus-group-next-group)
  1032.   (define-key gnus-group-mode-map "\C-p" 'gnus-group-prev-group)
  1033.   (define-key gnus-group-mode-map "\r" 'next-line)
  1034.   ;;(define-key gnus-group-mode-map "/" 'isearch-forward)
  1035.   (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
  1036.   (define-key gnus-group-mode-map ">" 'end-of-buffer)
  1037.   (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
  1038.   (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
  1039.   (define-key gnus-group-mode-map "c" 'gnus-group-catchup)
  1040.   (define-key gnus-group-mode-map "C" 'gnus-group-catchup-all)
  1041.   (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
  1042.   (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
  1043.   (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
  1044.   (define-key gnus-group-mode-map "R" 'gnus-group-restart)
  1045.   (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
  1046.   (define-key gnus-group-mode-map "r" 'gnus-group-restrict-groups)
  1047.   (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
  1048.   (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
  1049.   (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
  1050.   (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
  1051.   (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
  1052.   (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
  1053.   (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
  1054.   (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-list-killed-groups)
  1055.   (define-key gnus-group-mode-map "V" 'gnus-version)
  1056.   ;;(define-key gnus-group-mode-map "x" 'gnus-group-force-update)
  1057.   (define-key gnus-group-mode-map "s" 'gnus-group-force-update)
  1058.   (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
  1059.   (define-key gnus-group-mode-map "q" 'gnus-group-exit)
  1060.   (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
  1061.   (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
  1062.   (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node))
  1063.  
  1064. (defun gnus-group-mode ()
  1065.   "Major mode for reading network news.
  1066. All normal editing commands are turned off.
  1067. Instead, these commands are available:
  1068.  
  1069. SPC    Read articles in this newsgroup.
  1070. =    Select this newsgroup.
  1071. j    Move to the specified newsgroup.
  1072. n    Move to the next unread newsgroup.
  1073. p    Move to the previous unread newsgroup.
  1074. C-n    Move to the next newsgroup.
  1075. C-p    Move to the previous newsgroup.
  1076. <    Move point to the beginning of this buffer.
  1077. >    Move point to the end of this buffer.
  1078. u    Unsubscribe from (subscribe to) this newsgroup.
  1079. U    Unsubscribe from (subscribe to) the specified newsgroup.
  1080. c    Mark all articles as read, preserving marked articles.
  1081. C    Mark all articles in this newsgroup as read.
  1082. l    Revert this buffer.
  1083. L    List all newsgroups.
  1084. g    Get new news.
  1085. R    Force to read the raw .newsrc file and get new news.
  1086. b    Check bogus newsgroups.
  1087. r    Restrict visible newsgroups to the current region.
  1088. a    Post a new article.
  1089. ESC k    Edit a local KILL file applied to this newsgroup.
  1090. ESC K    Edit a global KILL file applied to all newsgroups.
  1091. C-k    Kill this newsgroup.
  1092. C-y    Yank killed newsgroup here.
  1093. C-w    Kill newsgroups in current region (excluding current point).
  1094. C-x C-t    Exchange this newsgroup and previous newsgroup.
  1095. C-c C-l    list killed newsgroups.
  1096. s    Save .newsrc file.
  1097. z    Suspend reading news.
  1098. q    Quit reading news.
  1099. Q    Quit reading news without saving .newsrc file.
  1100. V    Show the version number of this GNUS.
  1101. ?    Describe Group Mode commands briefly.
  1102. C-h m    Describe Group Mode.
  1103. C-c C-i    Read Info about Group Mode.
  1104.  
  1105.   The name of the host running NNTP server is asked for if no default
  1106. host is specified. It is also possible to choose another NNTP server
  1107. even when the default server is defined by giving a prefix argument to
  1108. the command `\\[gnus]'.
  1109.  
  1110.   If an NNTP server is preceded by a colon such as `:Mail', the user's
  1111. private directory `~/Mail' is used as a news spool. This makes it
  1112. possible to read mail stored in MH folders or articles saved by GNUS.
  1113. File names of mail or articles must consist of only numeric
  1114. characters. Otherwise, they are ignored.
  1115.  
  1116.   If there is a file named `~/.newsrc-SERVER', it is used as the
  1117. startup file instead of standard one when talking to SERVER.  It is
  1118. possible to talk to many hosts by using different startup files for
  1119. each.
  1120.  
  1121.   Option `-n' of the options line in the startup file is recognized
  1122. properly the same as the Bnews system. For example, if the options
  1123. line is `options -n !talk talk.rumors', newsgroups under the `talk'
  1124. hierarchy except for `talk.rumors' are ignored while checking new
  1125. newsgroups.
  1126.  
  1127.   If there is a file named `~/.signature-DISTRIBUTION', it is used as
  1128. signature file instead of standard one when posting a news in
  1129. DISTRIBUTION.
  1130.  
  1131.   If an Info file generated from `gnus.texinfo' is installed, you can
  1132. read an appropriate Info node of the Info file according to the
  1133. current major mode of GNUS by \\[gnus-info-find-node].
  1134.  
  1135.   The variable `gnus-version', `nntp-version', `nnspool-version', and
  1136. `mhspool-version' have the version numbers of this version of gnus.el,
  1137. nntp.el, nnspool.el, and mhspoo.el, respectively.
  1138.  
  1139. User customizable variables:
  1140.  gnus-nntp-server
  1141.     Specifies the name of the host running the NNTP server. If its
  1142.     value is a string such as `:DIRECTORY', the user's private
  1143.     DIRECTORY is used as a news spool.  The variable is initialized
  1144.     from the NNTPSERVER environment variable.
  1145.  
  1146.  gnus-nntp-service
  1147.     Specifies a NNTP service name.  It is usually \"nntp\" or 119.
  1148.     Nil forces GNUS to use a local news spool if the variable
  1149.     `gnus-nntp-server' is set to the local host name.
  1150.  
  1151.  gnus-startup-file
  1152.     Specifies a startup file (.newsrc).  If there is a file named
  1153.     `.newsrc-SERVER', it's used instead when talking to SERVER.  I
  1154.     recommend you to use the server specific file, if you'd like to
  1155.     talk to many servers.  Especially if you'd like to read your
  1156.     private directory, the name of the file must be
  1157.     `.newsrc-:DIRECTORY'.
  1158.  
  1159.  gnus-signature-file
  1160.     Specifies a signature file (.signature).  If there is a file named
  1161.     `.signature-DISTRIBUTION', it's used instead when posting an
  1162.     article in DISTRIBUTION.  Set the variable to nil to prevent
  1163.     appending the file automatically.  If you use an NNTP inews which
  1164.     comes with the NNTP package, you may have to set the variable to
  1165.     nil.
  1166.  
  1167.  gnus-use-cross-reference
  1168.     Specifies what to do with cross references (Xref: field).  If it
  1169.     is nil, cross references are ignored.  If it is t, articles in
  1170.     subscribed newsgroups are only marked as read.  Otherwise, if it
  1171.     is not nil nor t, articles in all newsgroups are marked as read.
  1172.  
  1173.  gnus-use-followup-to
  1174.     Specifies what to do with followup-to: field.  If it is nil, its
  1175.     value is ignored.  If it is non-nil, its value is used as followup
  1176.     newsgroups.  Especially, if it is t and field value is `poster',
  1177.     your confirmation is required.
  1178.  
  1179.  gnus-author-copy
  1180.     Specifies a file name to save a copy of article you posted using
  1181.     FCC: field.  If the first character of the value is `|', the
  1182.     contents of the article is piped out to a program specified by the
  1183.     rest of the value.  The variable is initialized from the
  1184.     AUTHORCOPY environment variable.
  1185.  
  1186.  gnus-author-copy-saver
  1187.     Specifies a function to save an author copy.  The function is
  1188.     called with a file name.  The default function `rmail-output'
  1189.     saves in Unix mail format.
  1190.  
  1191.  gnus-kill-file-name
  1192.     Use specified file name as a KILL file (default to `KILL').
  1193.  
  1194.  gnus-novice-user
  1195.     Non-nil means that you are a novice to USENET.  If non-nil,
  1196.     verbose messages may be displayed or your confirmations may be
  1197.     required.
  1198.  
  1199.  gnus-interactive-post
  1200.     Non-nil means that newsgroup, subject and distribution are asked
  1201.     for interactively when posting a new article.
  1202.  
  1203.  gnus-use-full-window
  1204.     Non-nil means to take up the entire screen of Emacs.
  1205.  
  1206.  gnus-window-configuration
  1207.     Specifies the configuration of Group, Summary, and Article
  1208.     windows.  It is a list of (ACTION (G S A)), where G, S, and A are
  1209.     the relative height of Group, Summary, and Article windows,
  1210.     respectively.  ACTION is `summary', `newsgroups', or `article'.
  1211.  
  1212.  gnus-subscribe-newsgroup-method
  1213.     Specifies a function called with a newsgroup name when new
  1214.     newsgroup is found.  The default definition adds new newsgroup at
  1215.     the beginning of other newsgroups.
  1216.  
  1217.   And more and more.  Please refer to texinfo documentation.
  1218.  
  1219. Various hooks for customization:
  1220.  gnus-group-mode-hook
  1221.     Entry to this mode calls the value with no arguments, if that
  1222.     value is non-nil. This hook is called before GNUS is connected to
  1223.     the NNTP server. So, you can change or define the NNTP server in
  1224.     this hook.
  1225.  
  1226.  gnus-startup-hook
  1227.     Called with no arguments after the NNTP server is selected. It is
  1228.     possible to change the behavior of GNUS or initialize the
  1229.     variables according to the selected NNTP server.
  1230.  
  1231.  gnus-group-prepare-hook
  1232.     Called with no arguments after a newsgroup list is created in the
  1233.     Newsgroup buffer, if that value is non-nil.
  1234.  
  1235.  gnus-save-newsrc-hook
  1236.     Called with no arguments when saving newsrc file if that value is
  1237.     non-nil.
  1238.  
  1239.  gnus-prepare-article-hook
  1240.     Called with no arguments after preparing message body, but before
  1241.     preparing header fields which is automatically generated if that
  1242.     value is non-nil.  The default hook (gnus-inews-insert-signature)
  1243.     inserts a signature file.
  1244.  
  1245.  gnus-inews-article-hook
  1246.     Called with no arguments when posting an article if that value is
  1247.     non-nil.  This hook is called just before posting an article.  The
  1248.     default hook does FCC (save an article to the specified file).
  1249.  
  1250.  gnus-suspend-gnus-hook
  1251.     Called with no arguments when suspending (not exiting) GNUS, if
  1252.     that value is non-nil.
  1253.  
  1254.  gnus-exit-gnus-hook
  1255.     Called with no arguments when exiting (not suspending) GNUS, if
  1256.     that value is non-nil."
  1257.   (interactive)
  1258.   (kill-all-local-variables)
  1259.   ;; Gee.  Why don't you upgrade?
  1260.   (cond ((boundp 'mode-line-modified)
  1261.      (setq mode-line-modified "--- "))
  1262.     ((listp (default-value 'mode-line-format))
  1263.      (setq mode-line-format
  1264.            (cons "--- " (cdr (default-value 'mode-line-format)))))
  1265.     (t
  1266.      (setq mode-line-format
  1267.            "--- GNUS: List of Newsgroups  %[(%m)%]----%3p-%-")))
  1268.   (setq major-mode 'gnus-group-mode)
  1269.   (setq mode-name "Newsgroup")
  1270.   (setq mode-line-buffer-identification    "GNUS: List of Newsgroups")
  1271.   (setq mode-line-process nil)
  1272.   (use-local-map gnus-group-mode-map)
  1273.   (buffer-disable-undo (current-buffer))
  1274.   (setq buffer-read-only t)        ;Disable modification
  1275.   (run-hooks 'gnus-group-mode-hook))
  1276.  
  1277. ;;;###autoload
  1278. (defun gnus (&optional confirm)
  1279.   "Read network news.
  1280. If optional argument CONFIRM is non-nil, ask NNTP server."
  1281.   (interactive "P")
  1282.   ;; Might as well build this in so that people know it exists...
  1283.   (if (string-match "XEmacs" emacs-version) (require 'gnus-xemacs))
  1284.   (unwind-protect
  1285.       (progn
  1286.     ;; XEmacs change: set the major mode before switching to the buffer,
  1287.     ;; for the benefit of auto-screen-selection code that may be driven
  1288.     ;; off of the major mode.
  1289.     (let ((buf (get-buffer-create gnus-group-buffer)))
  1290.       (set-buffer buf)
  1291.       (gnus-group-mode)
  1292.       (switch-to-buffer buf))
  1293.     (gnus-start-news-server confirm))
  1294.     (if (not (gnus-server-opened))
  1295.     (gnus-group-quit)
  1296.       ;; NNTP server is successfully open. 
  1297.       (setq mode-line-process (format " {%s}" gnus-nntp-server))
  1298.       (let ((buffer-read-only nil))
  1299.     (erase-buffer)
  1300.     (gnus-group-startup-message)
  1301.     (sit-for 0))
  1302.       (run-hooks 'gnus-startup-hook)
  1303.       (gnus-setup-news)
  1304.       (if gnus-novice-user
  1305.       (gnus-group-describe-briefly)) ;Show brief help message.
  1306.       (gnus-group-list-groups nil)
  1307.       )))
  1308.  
  1309. (defun gnus-group-startup-message ()
  1310.   "Insert startup message in current buffer."
  1311.   ;; Insert the message.
  1312.   (insert
  1313.    (format "
  1314.                    %s
  1315.  
  1316.          NNTP-based News Reader for GNU Emacs
  1317.  
  1318.  
  1319. If you have any trouble with this software, please let me
  1320. know. I will fix your problems in the next release.
  1321.  
  1322. Comments, suggestions, and bug fixes are welcome.
  1323.  
  1324. Masanobu UMEDA
  1325. umerin@mse.kyutech.ac.jp" gnus-version))
  1326.   ;; And then hack it.
  1327.   ;; 57 is the longest line.
  1328.   (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2))
  1329.   (goto-char (point-min))
  1330.   ;; +4 is fuzzy factor.
  1331.   (insert-char ?\n (/ (max (- (window-height) 18) 0) 2)))
  1332.  
  1333. ;; XEmacs change: faster version from flee@cse.psu.edu
  1334. (defun gnus-group-list-groups (show-all)
  1335.   "List newsgroups in the Newsgroup buffer.
  1336. If argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
  1337.   (interactive "P")
  1338.   (let ((case-fold-search nil)
  1339.     (current-group (gnus-group-group-name)))
  1340.     (set-buffer gnus-group-buffer)
  1341.     (gnus-group-prepare show-all)
  1342.     (if (zerop (buffer-size))
  1343.     (message "No news is good news")
  1344.       ;; Go to a point near the current newsgroup.
  1345.       (if current-group
  1346.       (gnus-group-find-group current-group)
  1347.     (goto-char (point-min)))
  1348.       (search-forward ":" nil t)
  1349.       )))
  1350.  
  1351. (defun gnus-group-prepare (&optional all)
  1352.   "Prepare list of newsgroups in current buffer.
  1353. If optional argument ALL is non-nil, unsubscribed groups are also listed."
  1354.   (let ((buffer-read-only nil)
  1355.     (newsrc gnus-newsrc-assoc)
  1356.     (group-info nil)
  1357.     (group-name nil)
  1358.     (unread-count 0)
  1359.     ;; This specifies the format of Group buffer.
  1360.     (cntl "%s%s%5d: %s%s\n")) ; XEmacs change
  1361.     (erase-buffer)
  1362.     ;; List newsgroups.
  1363.     (while newsrc
  1364.       (setq group-info (car newsrc))
  1365.       (setq group-name (car group-info))
  1366.       (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
  1367.       (if (or all
  1368.           (and (nth 1 group-info)    ;Subscribed.
  1369.            (> unread-count 0)))    ;There are unread articles.
  1370.       ;; Yes, I can use gnus-group-prepare-line, but this is faster.
  1371.       (insert
  1372.        (format cntl
  1373.            ;; Subscribed or not.
  1374.            (if (nth 1 group-info) " " "U")
  1375.            ;; Has new news?
  1376.            (if (and (> unread-count 0)
  1377.                 (>= 0
  1378.                 (- unread-count
  1379.                    (length
  1380.                     (cdr (gnus-gethash group-name
  1381.                                gnus-marked-hashtb))))))
  1382.                "*" " ")
  1383.            ;; Number of unread articles.
  1384.            unread-count
  1385.            ;; Newsgroup name.
  1386.            group-name
  1387.            ;; moderated-p (XEmacs addition)
  1388.            (if (and gnus-show-moderated
  1389.                 (null (nth 1 (gnus-gethash group-name
  1390.                                gnus-active-hashtb))))
  1391.                " (m)"
  1392.              "")
  1393.            ))
  1394.     )
  1395.       (setq newsrc (cdr newsrc))
  1396.       )
  1397.     (setq gnus-have-all-newsgroups all)
  1398.     (goto-char (point-min))
  1399.     (run-hooks 'gnus-group-prepare-hook)
  1400.     ))
  1401.  
  1402. (defun gnus-group-prepare-line (info)
  1403.   "Return a string for the Newsgroup buffer from INFO.
  1404. INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
  1405.   (let* ((group-name (car info))
  1406.      (unread-count
  1407.       (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
  1408.           ;; Not in hash table, so compute it now.
  1409.           (gnus-number-of-articles
  1410.            (gnus-difference-of-range
  1411.         (nth 2 (gnus-gethash group-name gnus-active-hashtb))
  1412.         (nthcdr 2 info)))))
  1413.      ;; This specifies the format of Group buffer.
  1414.      (cntl "%s%s%5d: %s%s\n")) ; XEmacs change
  1415.     (format cntl
  1416.         ;; Subscribed or not.
  1417.         (if (nth 1 info) " " "U")
  1418.         ;; Has new news?
  1419.         (if (and (> unread-count 0)
  1420.              (>= 0
  1421.              (- unread-count
  1422.                 (length
  1423.                  (cdr (gnus-gethash group-name
  1424.                         gnus-marked-hashtb))))))
  1425.         "*" " ")
  1426.         ;; Number of unread articles.
  1427.         unread-count
  1428.         ;; Newsgroup name.
  1429.         group-name
  1430.         ;; moderated-p (XEmacs addition)
  1431.         (if (and gnus-show-moderated
  1432.              (null (nth 1 (gnus-gethash group-name
  1433.                         gnus-active-hashtb))))
  1434.         " (m)"
  1435.           "")
  1436.         )))
  1437.  
  1438.  
  1439. ;; XEmacs change: from flee@cse.psu.edu
  1440. (defun gnus-bsearch-lines (predicate)
  1441.   "Uses binary search to find a line in the current buffer.  
  1442. PREDICATE is a zero-argument function called with point at the beginning of a
  1443. line.  It should return nil if point is before the target, non-nil if point is
  1444. equal to or after the target.  As a special case, if it returns the symbol
  1445. `junk', then this line is ignored.  PREDICATE must not change point.
  1446.  
  1447. On return, point will be at the beginning of the target line.  The
  1448. value of PREDICATE at that point is returned.
  1449.  
  1450. PREDICATE is called O(lg(lines) + junklines) times."
  1451.   (let ((lo (point-min))
  1452.     (hi (point-max))
  1453.     (value nil))
  1454.  
  1455.     ;; precondition:
  1456.     ;;   pred[min, target) == nil or junk
  1457.     ;;   pred[target] != nil or junk
  1458.     ;;   pred(target, max] != nil
  1459.     ;; invariant:
  1460.     ;;   min <= lo <= target <= hi <= max
  1461.     ;;   pred[min, lo) == nil or junk
  1462.     ;;   pred[hi] != nil or junk
  1463.     ;;   pred(hi, max] != nil
  1464.     ;; postcondition:
  1465.     ;;   lo == target == hi
  1466.  
  1467.     (while (< lo hi)
  1468.       ;; find the midpoint.
  1469.       (goto-char (/ (+ lo hi) 2))
  1470.       (beginning-of-line)
  1471.       ;; note: lo <= mid < hi
  1472.  
  1473.       ;; find the last non-junk line in [lo, mid]
  1474.       (while (and (eq (setq value (funcall predicate)) 'junk)
  1475.           (< lo (point)))
  1476.     (forward-line -1))
  1477.       (cond ((eq value 'junk)
  1478.          ;; all of [lo, mid] is junk, so target is in (mid, hi],
  1479.          ;; so we set lo := mid + 1
  1480.          (goto-char (/ (+ lo hi) 2))
  1481.          (forward-line 1)
  1482.          (setq lo (point)))
  1483.         (value
  1484.          ;; point is in [target, hi], so we set hi := point
  1485.          (setq hi (point)))
  1486.         (t
  1487.          ;; else point is in [lo, target), so we set lo := point + 1
  1488.          (forward-line 1)
  1489.          (setq lo (point)))
  1490.         ))
  1491.     ;; if `value' is nil or junk, then it's the value of the previous
  1492.     ;; line, so we need to call `predicate' to get the value at point.
  1493.     (or (and (not (eq value 'junk)) value)
  1494.     (funcall predicate))
  1495.     ))
  1496.  
  1497. ; (defun flee/line-string ()
  1498. ;     (buffer-substring
  1499. ;      (point) (save-excursion (end-of-line) (point))))
  1500. ; (progn
  1501. ;     (set-buffer "web2")
  1502. ;     (goto-char (point-min))
  1503. ;     (flee/time
  1504. ;      ;;'(re-search-forward "^pacific")
  1505. ;      ;;'(search-forward "\npacific")
  1506. ;      '(gnus-bsearch-lines
  1507. ;        '(lambda () (not (string< (downcase (flee/line-string)) "pacific"))))
  1508. ;      ))
  1509. ;;; Timings on a Sun 4/20, Emacs 19.19, built with gcc-2.4.5 -O2
  1510. ;;; find "pacific" in web2, at point 1429116 of 2486813 (57%)
  1511. ;;;  re-search-forward:    1.783s
  1512. ;;;  search-forward:    0.261s
  1513. ;;;  bsearch-lines:    0.014s
  1514.  
  1515. ;; XEmacs change: from flee@cse.psu.edu
  1516.  
  1517. ;;;; Some fast group searches in the *Newsgroup* buffer.
  1518.  
  1519. ;;; There are two search strategies: linear and binary.  In general,
  1520. ;;; the linear strategy is faster than the binary strategy, but the
  1521. ;;; binary strategy is able to find the "right" location to insert
  1522. ;;; non-visible groups in order to preserve newsrc order.
  1523.  
  1524. ;;; Basically, search-forward is very fast; gnus-group-group-name is
  1525. ;;; pretty slow; and re-search-forward is very slow.
  1526.  
  1527. ;;; Number of calls to gnus-group-group-name is the main limiting
  1528. ;;; factor in the speed of finding a group.
  1529.  
  1530. (defun gnus-group-find-group (group)
  1531.   ;; Start with linear search, but switch to binary if we can't find
  1532.   ;; it, or hit too many false positives.  This is functionally
  1533.   ;; equivalent to the binary search version, but substantially faster
  1534.   ;; in the common case.
  1535.  
  1536.   ;; The fudge factor for the linear search should really be something
  1537.   ;; like lg(lines), but making it a little larger is mostly harmless.
  1538.   (or (gnus-group-linear-find-group group 10)
  1539.       (gnus-group-binary-find-group group)))
  1540.  
  1541. ;; XEmacs change: from flee@cse.psu.edu
  1542. (defun gnus-group-linear-find-group (group &optional fudge)
  1543.   ;; Sets point to the beginning of the *Newsgroup* line for GROUP.
  1544.   ;; Returns nil if GROUP wasn't found.  Optional FUDGE argument means
  1545.   ;; give up after FUDGE false matches.
  1546.   (let ((found nil))
  1547.     (goto-char (point-min))
  1548.     (while (and (or (not fudge) (< 0 fudge))
  1549.         (not found)
  1550.         (search-forward group nil t))
  1551.       (if (string= (gnus-group-group-name) group)
  1552.       (setq found t)
  1553.     (forward-line 1)
  1554.     (if fudge
  1555.         (setq fudge (1- fudge)))
  1556.     ))
  1557.     (beginning-of-line)
  1558.     found))
  1559.  
  1560. ;; XEmacs change: from flee@cse.psu.edu
  1561. (defun gnus-group-binary-find-group (group)
  1562.   ;; Sets point to the beginning of the *Newsgroup* line for GROUP, or
  1563.   ;; the right place to insert GROUP to preserve newsrc order.
  1564.   ;; Returns nil if GROUP wasn't found."
  1565.  
  1566.   ;; We assume the *Newsgroup* buffer and gnus-newsrc-assoc are kept
  1567.   ;; in the same order.  `tail' is the tail of the newsrc-assoc
  1568.   ;; starting from `group'.  So `(memq this tail)' is true if `this'
  1569.   ;; is at or below the desired point.
  1570.   (let ((tail (memq (gnus-gethash group gnus-newsrc-hashtb)
  1571.             gnus-newsrc-assoc))
  1572.     (this nil))
  1573.     (string=
  1574.      (gnus-bsearch-lines
  1575.       (function (lambda ()
  1576.           (setq this (gnus-group-group-name))
  1577.           (if (not this)
  1578.               'junk
  1579.             (if (memq (gnus-gethash this gnus-newsrc-hashtb) tail)
  1580.             this)))))
  1581.      group)))
  1582.  
  1583. ;; XEmacs change: faster version from flee@cse.psu.edu
  1584. (defun gnus-group-update-group (group &optional visible-only)
  1585.   "Update newsgroup info of GROUP.
  1586. If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
  1587.   (let ((buffer-read-only nil))
  1588.     (if (gnus-group-find-group group)
  1589.     ;; Delete the old info line.
  1590.     (progn
  1591.       (delete-region (point) (progn (forward-line 1) (point)))
  1592.       (setq visible-only nil)    ; force a new info line
  1593.       ))
  1594.     ;; Insert a new info line.
  1595.     (or visible-only
  1596.     (progn
  1597.       (insert (gnus-group-prepare-line
  1598.            (gnus-gethash group gnus-newsrc-hashtb)))
  1599.       (forward-line -1)
  1600.       ))
  1601.     ))
  1602.  
  1603. ;; XEmacs change: faster version from flee@cse.psu.edu
  1604. (defun gnus-group-group-name ()
  1605.   (save-excursion
  1606.     (beginning-of-line)
  1607.     (if (search-forward ":" nil t)
  1608.     (if (looking-at " [^ \t\n]+")
  1609.         (buffer-substring (1+ (match-beginning 0)) (match-end 0))))))
  1610.  
  1611. (defun gnus-group-make-regexp (newsgroup)
  1612.   "Return regexp that matches for a line of NEWSGROUP."
  1613.   (concat "^.+: " (regexp-quote newsgroup) "\\([ \t].*\\|$\\)"))
  1614.  
  1615. (defun gnus-group-search-forward (backward norest &optional heretoo)
  1616.   "Search for the next (or previous) newsgroup.
  1617. If 1st argument BACKWARD is non-nil, search backward instead.
  1618. If 2nd argument NOREST is non-nil, don't care about newsgroup property.
  1619. If optional argument HERETOO is non-nil, current line is searched for, too."
  1620.   (let ((case-fold-search nil)
  1621.     (func
  1622.      (if backward
  1623.          (function re-search-backward) (function re-search-forward)))
  1624.     (regexp
  1625.      (format "^%s[ \t]*\\(%s\\):"
  1626.          (if norest ".." " [ \t]")
  1627.          (if norest "[0-9]+" "[1-9][0-9]*")))
  1628.     (found nil))
  1629.     (if backward
  1630.     (if heretoo
  1631.         (end-of-line)
  1632.       (beginning-of-line))
  1633.       (if heretoo
  1634.       (beginning-of-line)
  1635.     (end-of-line)))
  1636.     (setq found (funcall func regexp nil t))
  1637.     ;; Adjust cursor point.
  1638.     (beginning-of-line)
  1639.     (search-forward ":" nil t)
  1640.     ;; Return T if found.
  1641.     found
  1642.     ))
  1643.  
  1644. ;; GNUS Group mode command
  1645.  
  1646. (defun gnus-group-read-group (all &optional no-article)
  1647.   "Read news in this newsgroup.
  1648. If argument ALL is non-nil, already read articles become readable.
  1649. If optional argument NO-ARTICLE is non-nil, no article body is displayed."
  1650.   (interactive "P")
  1651.   (let ((group (gnus-group-group-name))) ;Newsgroup name to read.
  1652.     (if group
  1653.     (gnus-summary-read-group
  1654.      group
  1655.      (or all
  1656.          ;;(not (nth 1 (gnus-gethash group gnus-newsrc-hashtb))) ;Unsubscribed
  1657.          (zerop
  1658.           (nth 1 (gnus-gethash group gnus-unread-hashtb))))    ;No unread
  1659.      no-article
  1660.      ))
  1661.     ))
  1662.  
  1663. (defun gnus-group-select-group (all)
  1664.   "Select this newsgroup.
  1665. No article is selected automatically.
  1666. If argument ALL is non-nil, already read articles become readable."
  1667.   (interactive "P")
  1668.   (gnus-group-read-group all t))
  1669.  
  1670. ;; XEmacs change: new version from flee@cse.psu.edu
  1671. (defun gnus-group-jump-to-group (group)
  1672.   "Jump to newsgroup GROUP.
  1673. If GROUP isn't in your newsrc, subscribe to it by 
  1674. applying `gnus-subscribe-newsgroup-method'."
  1675.   (interactive
  1676.    (list (completing-read "Newsgroup: "
  1677.               gnus-active-hashtb nil 'require-match)))
  1678.   (set-buffer gnus-group-buffer)
  1679.   ;; If it's not in the newsrc, subscribe.
  1680.   (if (not (gnus-gethash group gnus-newsrc-hashtb))
  1681.       (funcall gnus-subscribe-newsgroup-method group))
  1682.   (gnus-group-update-group group)
  1683.   (search-forward ":" nil t))
  1684.  
  1685. (defun gnus-group-next-group (n)
  1686.   "Go to next N'th newsgroup."
  1687.   (interactive "p")
  1688.   (while (and (> n 1)
  1689.           (gnus-group-search-forward nil t))
  1690.     (setq n (1- n)))
  1691.   (or (gnus-group-search-forward nil t)
  1692.       (message "No more newsgroups")))
  1693.  
  1694. (defun gnus-group-next-unread-group (n)
  1695.   "Go to next N'th unread newsgroup."
  1696.   (interactive "p")
  1697.   (while (and (> n 1)
  1698.           (gnus-group-search-forward nil nil))
  1699.     (setq n (1- n)))
  1700.   (or (gnus-group-search-forward nil nil)
  1701.       (message "No more unread newsgroups")))
  1702.  
  1703. (defun gnus-group-prev-group (n)
  1704.   "Go to previous N'th newsgroup."
  1705.   (interactive "p")
  1706.   (while (and (> n 1)
  1707.           (gnus-group-search-forward t t))
  1708.     (setq n (1- n)))
  1709.   (or (gnus-group-search-forward t t)
  1710.       (message "No more newsgroups")))
  1711.  
  1712. (defun gnus-group-prev-unread-group (n)
  1713.   "Go to previous N'th unread newsgroup."
  1714.   (interactive "p")
  1715.   (while (and (> n 1)
  1716.           (gnus-group-search-forward t nil))          
  1717.     (setq n (1- n)))
  1718.   (or (gnus-group-search-forward t nil)
  1719.       (message "No more unread newsgroups")))
  1720.  
  1721. (defun gnus-group-catchup (all)
  1722.   "Mark all articles not marked as unread in current newsgroup as read.
  1723. If prefix argument ALL is non-nil, all articles are marked as read.
  1724. Cross references (Xref: field) of articles are ignored."
  1725.   (interactive "P")
  1726.   (let* ((group (gnus-group-group-name))
  1727.          (marked (if (not all)
  1728.              (cdr (gnus-gethash group gnus-marked-hashtb)))))
  1729.     (and group
  1730.      (or (not gnus-interactive-catchup) ;Without confirmation?
  1731.          (y-or-n-p
  1732.           (if all
  1733.           "Do you really want to mark everything as read? "
  1734.         "Delete all articles not marked as read? ")))
  1735.      (progn
  1736.        (message "")            ;Clear "Yes or No" question.
  1737.        ;; Any marked articles will be preserved.
  1738.        (gnus-update-unread-articles group marked marked)
  1739.        (gnus-group-update-group group)
  1740.        (gnus-group-next-group 1)))
  1741.     ))
  1742.  
  1743. (defun gnus-group-catchup-all ()
  1744.   "Mark all articles in current newsgroup as read.
  1745. Cross references (Xref: field) of articles are ignored."
  1746.   (interactive)
  1747.   (gnus-group-catchup t))
  1748.  
  1749. (defun gnus-group-unsubscribe-current-group ()
  1750.   "Toggle subscribe from/to unsubscribe current group."
  1751.   (interactive)
  1752.   (gnus-group-unsubscribe-group (gnus-group-group-name))
  1753.   (gnus-group-next-group 1))
  1754.  
  1755. (defun gnus-group-unsubscribe-group (group)
  1756.   "Toggle subscribe from/to unsubscribe GROUP.
  1757. New newsgroup is added to .newsrc automatically."
  1758.   (interactive
  1759.    (list (completing-read "Newsgroup: "
  1760.               gnus-active-hashtb nil 'require-match)))
  1761.   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
  1762.     (cond ((not (null newsrc))
  1763.        ;; Toggle subscription flag.
  1764.        (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
  1765.        (gnus-update-newsrc-buffer group)
  1766.        (gnus-group-update-group group)
  1767.        ;; Adjust cursor point.
  1768.        (beginning-of-line)
  1769.        (search-forward ":" nil t))
  1770.       ((and (stringp group)
  1771.         (gnus-gethash group gnus-active-hashtb))
  1772.        ;; Add new newsgroup.
  1773.        (gnus-add-newsgroup group)
  1774.        (gnus-group-update-group group)
  1775.        ;; Adjust cursor point.
  1776.        (beginning-of-line)
  1777.        (search-forward ":" nil t))
  1778.       (t (error "No such newsgroup: %s" group)))
  1779.     ))
  1780.  
  1781. (defun gnus-group-list-all-groups ()
  1782.   "List all of newsgroups in the Newsgroup buffer."
  1783.   (interactive)
  1784.   (gnus-group-list-groups t))
  1785.  
  1786. (defun gnus-group-get-new-news ()
  1787.   "Get newly arrived articles. In fact, read the active file again."
  1788.   (interactive)
  1789.   (gnus-setup-news)
  1790.   (gnus-group-list-groups gnus-have-all-newsgroups))
  1791.  
  1792. (defun gnus-group-restart ()
  1793.   "Force GNUS to read the raw startup file."
  1794.   (interactive)
  1795.   (gnus-save-newsrc-file)
  1796.   (gnus-setup-news t)            ;Force to read the raw startup file.
  1797.   (gnus-group-list-groups gnus-have-all-newsgroups))
  1798.  
  1799. (defun gnus-group-check-bogus-groups ()
  1800.   "Check bogus newsgroups."
  1801.   (interactive)
  1802.   (gnus-check-bogus-newsgroups t)    ;Require confirmation.
  1803.   (gnus-group-list-groups gnus-have-all-newsgroups))
  1804.  
  1805. (defun gnus-group-restrict-groups (start end)
  1806.   "Restrict visible newsgroups to the current region (START and END).
  1807. Type \\[widen] to remove restriction."
  1808.   (interactive "r")
  1809.   (save-excursion
  1810.     (narrow-to-region (progn
  1811.             (goto-char start)
  1812.             (beginning-of-line)
  1813.             (point))
  1814.               (progn
  1815.             (goto-char end)
  1816.             (forward-line 1)
  1817.             (point))))
  1818.   (message (substitute-command-keys "Type \\[widen] to remove restriction")))
  1819.  
  1820. (defun gnus-group-edit-global-kill ()
  1821.   "Edit a global KILL file."
  1822.   (interactive)
  1823.   (setq gnus-current-kill-article nil)    ;No articles selected.
  1824.   (gnus-kill-file-edit-file nil)     ;Nil stands for global KILL file.
  1825.   (message
  1826.    (substitute-command-keys
  1827.     "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
  1828.  
  1829. (defun gnus-group-edit-local-kill ()
  1830.   "Edit a local KILL file."
  1831.   (interactive)
  1832.   (setq gnus-current-kill-article nil)    ;No articles selected.
  1833.   (gnus-kill-file-edit-file (gnus-group-group-name))
  1834.   (message
  1835.    (substitute-command-keys
  1836.     "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
  1837.  
  1838. (defun gnus-group-force-update ()
  1839.   "Update .newsrc file."
  1840.   (interactive)
  1841.   (gnus-save-newsrc-file))
  1842.  
  1843. (defun gnus-group-suspend ()
  1844.   "Suspend the current GNUS session.
  1845. In fact, cleanup buffers except for Group Mode buffer.
  1846. The hook gnus-suspend-gnus-hook is called before actually suspending."
  1847.   (interactive)
  1848.   (run-hooks 'gnus-suspend-gnus-hook)
  1849.   ;; Kill GNUS buffers except for Group Mode buffer.
  1850.   (let ((buffers gnus-buffer-list))
  1851.     (while buffers
  1852.       (and (not (eq (car buffers) gnus-group-buffer))
  1853.        (get-buffer (car buffers))
  1854.        (kill-buffer (car buffers)))
  1855.       (setq buffers (cdr buffers))
  1856.       ))
  1857.   (bury-buffer))
  1858.  
  1859. (defun gnus-group-exit ()
  1860.   "Quit reading news after updating .newsrc.
  1861. The hook gnus-exit-gnus-hook is called before actually quitting."
  1862.   (interactive)
  1863.   (if (or noninteractive        ;For gnus-batch-kill
  1864.       (zerop (buffer-size))        ;No news is good news.
  1865.       (not (gnus-server-opened))    ;NNTP connection closed.
  1866.       (not gnus-interactive-exit)    ;Without confirmation
  1867.       (y-or-n-p "Are you sure you want to quit reading news? "))
  1868.       (progn
  1869.     (message "")            ;Erase "Yes or No" question.
  1870.     (run-hooks 'gnus-exit-gnus-hook)
  1871.     (gnus-save-newsrc-file)
  1872.     (gnus-clear-system)
  1873.     (gnus-close-server))
  1874.     ))
  1875.  
  1876. (defun gnus-group-quit ()
  1877.   "Quit reading news without updating .newsrc.
  1878. The hook gnus-exit-gnus-hook is called before actually quitting."
  1879.   (interactive)
  1880.   (if (or noninteractive        ;For gnus-batch-kill
  1881.       (zerop (buffer-size))
  1882.       (not (gnus-server-opened))
  1883.       (yes-or-no-p
  1884.        (format "Quit reading news without saving %s? "
  1885.            (file-name-nondirectory gnus-current-startup-file))))
  1886.       (progn
  1887.     (message "")            ;Erase "Yes or No" question.
  1888.     (run-hooks 'gnus-exit-gnus-hook)
  1889.     (gnus-clear-system)
  1890.     (gnus-close-server))
  1891.     ))
  1892.  
  1893. (defun gnus-group-describe-briefly ()
  1894.   "Describe Group mode commands briefly."
  1895.   (interactive)
  1896.   (message
  1897.    (concat
  1898.     (substitute-command-keys "\\[gnus-group-read-group]:Select  ")
  1899.     (substitute-command-keys "\\[gnus-group-next-unread-group]:Forward  ")
  1900.     (substitute-command-keys "\\[gnus-group-prev-unread-group]:Backward  ")
  1901.     (substitute-command-keys "\\[gnus-group-exit]:Exit  ")
  1902.     (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
  1903.     (substitute-command-keys "\\[gnus-group-describe-briefly]:This help")
  1904.     )))
  1905.  
  1906.  
  1907. ;;;
  1908. ;;; GNUS Summary Mode
  1909. ;;;
  1910.  
  1911. (if gnus-summary-mode-map
  1912.     nil
  1913.   (setq gnus-summary-mode-map (make-keymap))
  1914.   (suppress-keymap gnus-summary-mode-map)
  1915.   (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
  1916.   (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
  1917.   (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
  1918.   (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
  1919.   (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
  1920.   (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
  1921.   (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
  1922.   (define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-same-subject)
  1923.   (define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-same-subject)
  1924.   ;;(define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-unread-same-subject)
  1925.   ;;(define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-unread-same-subject)
  1926.   (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest)
  1927.   (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest)
  1928.   (define-key gnus-summary-mode-map "\C-n" 'gnus-summary-next-subject)
  1929.   (define-key gnus-summary-mode-map "\C-p" 'gnus-summary-prev-subject)
  1930.   (define-key gnus-summary-mode-map "\en" 'gnus-summary-next-unread-subject)
  1931.   (define-key gnus-summary-mode-map "\ep" 'gnus-summary-prev-unread-subject)
  1932.   ;;(define-key gnus-summary-mode-map "\C-cn" 'gnus-summary-next-group)
  1933.   ;;(define-key gnus-summary-mode-map "\C-cp" 'gnus-summary-prev-group)
  1934.   (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
  1935.   ;;(define-key gnus-summary-mode-map "/" 'isearch-forward)
  1936.   (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
  1937.   (define-key gnus-summary-mode-map "\es" 'gnus-summary-search-article-forward)
  1938.   ;;(define-key gnus-summary-mode-map "\eS" 'gnus-summary-search-article-backward)
  1939.   (define-key gnus-summary-mode-map "\er" 'gnus-summary-search-article-backward)
  1940.   (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
  1941.   (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
  1942.   (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
  1943.   ;;(define-key gnus-summary-mode-map "J" 'gnus-summary-goto-article)
  1944.   (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
  1945.   (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
  1946.   ;;(define-key gnus-summary-mode-map "\er" 'gnus-summary-refer-article)
  1947.   (define-key gnus-summary-mode-map "\e^" 'gnus-summary-refer-article)
  1948.   (define-key gnus-summary-mode-map "u" 'gnus-summary-mark-as-unread-forward)
  1949.   (define-key gnus-summary-mode-map "U" 'gnus-summary-mark-as-unread-backward)
  1950.   (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
  1951.   (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
  1952.   (define-key gnus-summary-mode-map "\eu" 'gnus-summary-clear-mark-forward)
  1953.   (define-key gnus-summary-mode-map "\eU" 'gnus-summary-clear-mark-backward)
  1954.   (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
  1955.   (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
  1956.   (define-key gnus-summary-mode-map "\e\C-t" 'gnus-summary-toggle-threads)
  1957.   (define-key gnus-summary-mode-map "\e\C-s" 'gnus-summary-show-thread)
  1958.   (define-key gnus-summary-mode-map "\e\C-h" 'gnus-summary-hide-thread)
  1959.   (define-key gnus-summary-mode-map "\e\C-f" 'gnus-summary-next-thread)
  1960.   (define-key gnus-summary-mode-map "\e\C-b" 'gnus-summary-prev-thread)
  1961.   (define-key gnus-summary-mode-map "\e\C-u" 'gnus-summary-up-thread)
  1962.   (define-key gnus-summary-mode-map "\e\C-d" 'gnus-summary-down-thread)
  1963.   (define-key gnus-summary-mode-map "\e\C-k" 'gnus-summary-kill-thread)
  1964.   (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
  1965.   ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup)
  1966.   ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all)
  1967.   (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
  1968.   ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all-and-exit)
  1969.   (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
  1970.   (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read)
  1971.   (define-key gnus-summary-mode-map "X" 'gnus-summary-delete-marked-with)
  1972.   (define-key gnus-summary-mode-map "\C-c\C-sn" 'gnus-summary-sort-by-number)
  1973.   (define-key gnus-summary-mode-map "\C-c\C-sa" 'gnus-summary-sort-by-author)
  1974.   (define-key gnus-summary-mode-map "\C-c\C-ss" 'gnus-summary-sort-by-subject)
  1975.   (define-key gnus-summary-mode-map "\C-c\C-sd" 'gnus-summary-sort-by-date)
  1976.   (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
  1977.   (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
  1978.   (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
  1979.   (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
  1980.   (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
  1981.   ;;(define-key gnus-summary-mode-map "G" 'gnus-summary-reselect-current-group)
  1982.   (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
  1983.   (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
  1984.   (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
  1985.   (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
  1986.   (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
  1987.   ;;(define-key gnus-summary-mode-map "v" 'gnus-summary-show-all-headers)
  1988.   (define-key gnus-summary-mode-map "\et" 'gnus-summary-toggle-mime)
  1989.   ;; XEmacs change
  1990.   (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-read-digest)
  1991.   (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
  1992.   (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
  1993.   (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
  1994.   (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
  1995.   (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
  1996.   (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
  1997.   (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
  1998.   (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
  1999.   (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
  2000.   (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-in-mail)
  2001.   (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
  2002.   (define-key gnus-summary-mode-map "\ek" 'gnus-summary-edit-local-kill)
  2003.   (define-key gnus-summary-mode-map "\eK" 'gnus-summary-edit-global-kill)
  2004.   (define-key gnus-summary-mode-map "V" 'gnus-version)
  2005.   (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
  2006.   (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit)
  2007.   (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
  2008.   (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node))
  2009.  
  2010. (defun gnus-summary-mode ()
  2011.   "Major mode for reading articles in this newsgroup.
  2012. All normal editing commands are turned off.
  2013. Instead, these commands are available:
  2014.  
  2015. SPC    Scroll to the next page of the current article.  The next unread
  2016.     article is selected automatically at the end of the message.
  2017. DEL    Scroll to the previous page of the current article.
  2018. RET    Scroll up (or down) one line the current article.
  2019. n    Move to the next unread article.
  2020. p    Move to the previous unread article.
  2021. N    Move to the next article.
  2022. P    Move to the previous article.
  2023. ESC C-n    Move to the next article which has the same subject as the
  2024.     current article.
  2025. ESC C-p    Move to the previous article which has the same subject as the
  2026.     current article.
  2027. \\[gnus-summary-next-unread-same-subject]
  2028.     Move to the next unread article which has the same subject as the
  2029.     current article.
  2030. \\[gnus-summary-prev-unread-same-subject]
  2031.     Move to the previous unread article which has the same subject as
  2032.     the current article.
  2033. C-c C-n    Scroll to the next digested message of the current article.
  2034. C-c C-p    Scroll to the previous digested message of the current article.
  2035. C-n    Move to the next subject.
  2036. C-p    Move to the previous subject.
  2037. ESC n    Move to the next unread subject.
  2038. ESC p    Move to the previous unread subject.
  2039. \\[gnus-summary-next-group]
  2040.     Exit the current newsgroup and select the next unread newsgroup.
  2041. \\[gnus-summary-prev-group]
  2042.     Exit the current newsgroup and select the previous unread newsgroup.
  2043. .    Jump to the first unread article in the current newsgroup.
  2044. s    Do an incremental search forward on the current article.
  2045. ESC s    Search for an article containing a regexp forward.
  2046. ESC r    Search for an article containing a regexp backward.
  2047. <    Move point to the beginning of the current article.
  2048. >    Move point to the end of the current article.
  2049. j    Jump to the article specified by the numeric article ID.
  2050. l    Jump to the article you read last.
  2051. ^    Refer to parent of the current article.
  2052. ESC ^    Refer to the article specified by the Message-ID.
  2053. u    Mark the current article as unread, and go forward.
  2054. U    Mark the current article as unread, and go backward.
  2055. d    Mark the current article as read, and go forward.
  2056. D    Mark the current article as read, and go backward.
  2057. ESC u    Clear the current article's mark, and go forward.
  2058. ESC U    Clear the current article's mark, and go backward.
  2059. k    Mark articles which has the same subject as the current article as
  2060.     read, and then select the next unread article.
  2061. C-k    Mark articles which has the same subject as the current article as
  2062.     read.
  2063. ESC k    Edit a local KILL file applied to the current newsgroup.
  2064. ESC K    Edit a global KILL file applied to all newsgroups.
  2065. ESC C-t    Toggle showing conversation threads.
  2066. ESC C-s    Show thread subtrees.
  2067. ESC C-h    Hide thread subtrees.
  2068. \\[gnus-summary-show-all-threads]    Show all thread subtrees.
  2069. \\[gnus-summary-hide-all-threads]    Hide all thread subtrees.
  2070. ESC C-f    Go to the same level next thread.
  2071. ESC C-b    Go to the same level previous thread.
  2072. ESC C-d    Go downward current thread.
  2073. ESC C-u    Go upward current thread.
  2074. ESC C-k    Mark articles under current thread as read.
  2075. &    Execute a command for each article conditionally.
  2076. \\[gnus-summary-catchup]
  2077.     Mark all articles as read in the current newsgroup, preserving
  2078.     articles marked as unread.
  2079. \\[gnus-summary-catchup-all]
  2080.     Mark all articles as read in the current newsgroup.
  2081. \\[gnus-summary-catchup-and-exit]
  2082.     Catch up all articles not marked as unread, and then exit the
  2083.     current newsgroup.
  2084. \\[gnus-summary-catchup-all-and-exit]
  2085.     Catch up all articles, and then exit the current newsgroup.
  2086. C-t    Toggle truncations of subject lines.
  2087. x    Delete subject lines marked as read.
  2088. X    Delete subject lines with the specific marks.
  2089. C-c C-s C-n    Sort subjects by article number.
  2090. C-c C-s C-a    Sort subjects by article author.
  2091. C-c C-s C-s    Sort subjects alphabetically.
  2092. C-c C-s C-d    Sort subjects by date.
  2093. =    Expand Summary window to show headers full window.
  2094. C-x C-s    Reselect the current newsgroup. Prefix argument means to select all.
  2095. w    Stop page breaking by linefeed.
  2096. C-c C-r    Caesar rotates letters by 13/47 places.
  2097. g    Force to show the current article.
  2098. t    Show original article header if pruned header currently shown, or
  2099.     vice versa.
  2100. ESC-t    Toggle MIME processing.
  2101. C-d    Expand the current message as a digest.
  2102. a    Post a new article.
  2103. f    Post a reply article.
  2104. F    Post a reply article with original article.
  2105. C    Cancel the current article.
  2106. r    Mail a message to the author.
  2107. R    Mail a message to the author with original author.
  2108. C-c C-f    Forward the current message to another user.
  2109. m    Mail a message in other window.
  2110. o    Save the current article in your favorite format.
  2111. C-o    Append the current article to a file in Unix mail format.
  2112. |    Pipe the contents of the current article to a subprocess.
  2113. q    Quit reading news in the current newsgroup.
  2114. Q    Quit reading news without recording unread articles information.
  2115. V    Show the version number of this GNUS.
  2116. ?    Describe Summary mode commands briefly.
  2117. C-h m    Describe Summary mode.
  2118. C-c C-i    Read Info about Summary mode.
  2119.  
  2120. User customizable variables:
  2121.  gnus-large-newsgroup
  2122.     The number of articles which indicates a large newsgroup. If the
  2123.     number of articles in a newsgroup is greater than the value, the
  2124.     number of articles to be selected is asked for. If the given value
  2125.     N is positive, the last N articles is selected. If N is negative,
  2126.     the first N articles are selected. An empty string means to select
  2127.     all articles.
  2128.  
  2129.  gnus-use-long-file-name
  2130.     Non-nil means that a newsgroup name is used as a default file name
  2131.     to save articles to. If it's nil, the directory form of a
  2132.     newsgroup is used instead.
  2133.  
  2134.  gnus-default-article-saver
  2135.     Specifies your favorite article saver which is interactively
  2136.     funcallable. Following functions are available:
  2137.  
  2138.     gnus-summary-save-in-rmail (in Rmail format)
  2139.     gnus-summary-save-in-mail (in Unix mail format)
  2140.     gnus-summary-save-in-folder (in MH folder)
  2141.     gnus-summary-save-in-file (in article format).
  2142.  
  2143.  gnus-rmail-save-name
  2144.  gnus-mail-save-name
  2145.  gnus-folder-save-name
  2146.  gnus-file-save-name
  2147.     Specifies a function generating a file name to save articles in
  2148.     specified format.  The function is called with NEWSGROUP, HEADERS,
  2149.     and optional LAST-FILE.  Access macros to the headers are defined
  2150.     as nntp-header-FIELD, and functions are defined as
  2151.     gnus-header-FIELD.
  2152.  
  2153.  gnus-article-save-directory
  2154.     Specifies a directory name to save articles to using the commands
  2155.     gnus-summary-save-in-rmail, gnus-summary-save-in-mail and
  2156.     gnus-summary-save-in-file. The variable is initialized from the
  2157.     SAVEDIR environment variable.
  2158.  
  2159.  gnus-show-all-headers
  2160.     Non-nil means that all headers of an article are shown.
  2161.  
  2162.  gnus-save-all-headers
  2163.     Non-nil means that all headers of an article are saved in a file.
  2164.  
  2165.  gnus-show-mime
  2166.     Non-nil means that show a MIME message.
  2167.  
  2168.  gnus-show-threads
  2169.     Non-nil means that conversation threads are shown in tree structure.
  2170.  
  2171.  gnus-thread-hide-subject
  2172.     Non-nil means that subjects for thread subtrees are hidden.
  2173.  
  2174.  gnus-thread-hide-subtree
  2175.     Non-nil means that thread subtrees are hidden initially.
  2176.  
  2177.  gnus-thread-hide-killed
  2178.     Non-nil means that killed thread subtrees are hidden automatically.
  2179.  
  2180.  gnus-thread-ignore-subject
  2181.     Non-nil means that subject differences are ignored in constructing
  2182.     thread trees.
  2183.  
  2184.  gnus-thread-indent-level
  2185.     Indentation of thread subtrees.
  2186.  
  2187.  gnus-optional-headers
  2188.     Specifies a function which generates an optional string displayed
  2189.     in the Summary buffer. The function is called with an article
  2190.     HEADERS.  The result must be a string excluding `[' and `]'.  The
  2191.     default function returns a string like NNN:AUTHOR, where NNN is
  2192.     the number of lines in an article and AUTHOR is the name of the
  2193.     author.
  2194.  
  2195.  gnus-auto-extend-newsgroup
  2196.     Non-nil means visible articles are extended to forward and
  2197.     backward automatically if possible.
  2198.  
  2199.  gnus-auto-select-first
  2200.     Non-nil means the first unread article is selected automagically
  2201.     when a newsgroup is selected normally (by gnus-group-read-group).
  2202.     If you'd like to prevent automatic selection of the first unread
  2203.     article in some newsgroups, set the variable to nil in
  2204.     gnus-select-group-hook or gnus-apply-kill-hook.
  2205.  
  2206.  gnus-auto-select-next
  2207.     Non-nil means the next newsgroup is selected automagically at the
  2208.     end of the newsgroup. If the value is t and the next newsgroup is
  2209.     empty (no unread articles), GNUS will exit Summary mode and go
  2210.     back to Group mode. If the value is neither nil nor t, GNUS won't
  2211.     exit Summary mode but select the following unread newsgroup.
  2212.     Especially, if the value is the symbol `quietly', the next unread
  2213.     newsgroup will be selected without any confirmations.
  2214.  
  2215.  gnus-auto-select-same
  2216.     Non-nil means an article with the same subject as the current
  2217.     article is selected automagically like `rn -S'.
  2218.  
  2219.  gnus-auto-center-summary
  2220.     Non-nil means the point of Summary Mode window is always kept
  2221.     centered.
  2222.  
  2223.  gnus-break-pages
  2224.     Non-nil means an article is broken into pages at page delimiters.
  2225.     This may not work with some versions of GNU Emacs earlier than
  2226.     version 18.50.
  2227.  
  2228.  gnus-page-delimiter
  2229.     Specifies a regexp describing line-beginnings that separate pages
  2230.     of news article.
  2231.  
  2232.  [gnus-more-message is obsolete.  overlay-arrow-string interfares
  2233.     with other subsystems, such as dbx mode.]
  2234.  
  2235.  gnus-digest-show-summary
  2236.     Non-nil means that a summary of digest messages is shown when
  2237.     reading a digest article using `gnus-summary-rmail-digest'
  2238.     command.
  2239.  
  2240.  gnus-digest-separator
  2241.     Specifies a regexp separating messages in a digest article.
  2242.  
  2243.  gnus-mail-reply-method
  2244.  gnus-mail-other-window-method
  2245.     Specifies a function to begin composing mail message using
  2246.     commands gnus-summary-reply and gnus-summary-mail-other-window.
  2247.     Functions gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe
  2248.     are available for the value of gnus-mail-reply-method.  And
  2249.     functions gnus-mail-other-window-using-mail and
  2250.     gnus-mail-other-window-using-mhe are available for the value of
  2251.     gnus-mail-other-window-method.
  2252.  
  2253.  gnus-mail-send-method
  2254.     Specifies a function to mail a message too which is being posted
  2255.     as an article.  The message must have To: or Cc: field.  The value
  2256.     of the variable send-mail-function is the default function which
  2257.     uses sendmail mail program.
  2258.  
  2259. Various hooks for customization:
  2260.  gnus-summary-mode-hook
  2261.     Entry to this mode calls the value with no arguments, if that
  2262.     value is non-nil.
  2263.  
  2264.  gnus-select-group-hook
  2265.     Called with no arguments when newsgroup is selected, if that value
  2266.     is non-nil. It is possible to sort subjects in this hook. See the
  2267.     documentation of this variable for more information.
  2268.  
  2269.  gnus-summary-prepare-hook
  2270.     Called with no arguments after a summary list is created in the
  2271.     Summary buffer, if that value is non-nil. If you'd like to modify
  2272.     the buffer, you can use this hook.
  2273.  
  2274.  gnus-select-article-hook
  2275.     Called with no arguments when an article is selected, if that
  2276.     value is non-nil. See the documentation of this variable for more
  2277.     information.
  2278.  
  2279.  gnus-select-digest-hook
  2280.     Called with no arguments when reading digest messages using Rmail,
  2281.     if that value is non-nil. This hook can be used to modify an
  2282.     article so that Rmail can work with it. See the documentation of
  2283.     the variable for more information.
  2284.  
  2285.  gnus-rmail-digest-hook
  2286.     Called with no arguments when reading digest messages using Rmail,
  2287.     if that value is non-nil. This hook is intended to customize Rmail
  2288.     mode.
  2289.  
  2290.  gnus-apply-kill-hook
  2291.     Called with no arguments when a newsgroup is selected and the
  2292.     Summary buffer is prepared. This hook is intended to apply a KILL
  2293.     file to the selected newsgroup. The format of KILL file is
  2294.     completely different from that of version 3.8. You have to rewrite
  2295.     them in the new format. See the documentation of Kill file mode
  2296.     for more information.
  2297.  
  2298.  gnus-mark-article-hook
  2299.     Called with no arguments when an article is selected at the first
  2300.     time. The hook is intended to mark an article as read (or unread)
  2301.     automatically when it is selected.  See the documentation of the
  2302.     variable for more information.
  2303.  
  2304.  gnus-exit-group-hook
  2305.     Called with no arguments when exiting the current newsgroup, if
  2306.     that value is non-nil. If your machine is so slow that exiting
  2307.     from Summary mode takes very long time, inhibit marking articles
  2308.     as read using cross-references by setting the variable
  2309.     gnus-use-cross-reference to nil in this hook."
  2310.   (interactive)
  2311.   (kill-all-local-variables)
  2312.   ;; Gee.  Why don't you upgrade?
  2313.   (cond ((boundp 'mode-line-modified)
  2314.      (setq mode-line-modified "--- "))
  2315.     ((listp (default-value 'mode-line-format))
  2316.      (setq mode-line-format
  2317.            (cons "--- " (cdr (default-value 'mode-line-format))))))
  2318.   ;; To disable display-time facility.
  2319.   ;;(make-local-variable 'global-mode-string)
  2320.   ;;(setq global-mode-string nil)
  2321.   (setq major-mode 'gnus-summary-mode)
  2322.   (setq mode-name "Summary")
  2323.   ;;(setq mode-line-process '(" " gnus-newsgroup-name))
  2324.   (make-local-variable 'minor-mode-alist)
  2325.   (or (assq 'gnus-show-threads minor-mode-alist)
  2326.       (setq minor-mode-alist
  2327.         (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
  2328.   (gnus-summary-set-mode-line)
  2329.   (use-local-map gnus-summary-mode-map)
  2330.   (buffer-disable-undo (current-buffer))
  2331.   (setq buffer-read-only t)        ;Disable modification
  2332.   (setq truncate-lines t)        ;Stop line folding
  2333.   (setq selective-display t)
  2334.   (setq selective-display-ellipses t)    ;Display `...'
  2335.   ;;(setq case-fold-search t)
  2336.   (run-hooks 'gnus-summary-mode-hook))
  2337.  
  2338. (defun gnus-summary-setup-buffer ()
  2339.   "Initialize Summary buffer."
  2340.   (if (get-buffer gnus-summary-buffer)
  2341.       (set-buffer gnus-summary-buffer)
  2342.     (set-buffer (get-buffer-create gnus-summary-buffer))
  2343.     (gnus-summary-mode)
  2344.     ))
  2345.  
  2346. (defun gnus-summary-read-group (group &optional show-all no-article)
  2347.   "Start reading news in newsgroup GROUP.
  2348. If optional 1st argument SHOW-ALL is non-nil, already read articles are
  2349. also listed.
  2350. If optional 2nd argument NO-ARTICLE is non-nil, no article is selected
  2351. initially."
  2352.   (message "Retrieving newsgroup: %s..." group)
  2353.   (if (gnus-select-newsgroup group show-all)
  2354.       (progn
  2355.     ;; Don't switch-to-buffer to prevent displaying old contents
  2356.     ;;  of the buffer until new subjects list is created.
  2357.     ;; Suggested by Juha Heinanen <jh@tut.fi>
  2358.     (gnus-summary-setup-buffer)
  2359.     ;; You can change the order of subjects in this hook.
  2360.     (run-hooks 'gnus-select-group-hook)
  2361.     (gnus-summary-prepare)
  2362.     ;; Function `gnus-apply-kill-file' must be called in this hook.
  2363.     (run-hooks 'gnus-apply-kill-hook)
  2364.     (if (zerop (buffer-size))
  2365.         ;; This newsgroup is empty.
  2366.         (progn
  2367.           (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
  2368.           (message "No unread news"))
  2369.       ;; Hide conversation thread subtrees.  We cannot do this in
  2370.       ;; gnus-summary-prepare-hook since kill processing may not
  2371.       ;; work with hidden articles.
  2372.       (and gnus-show-threads
  2373.            gnus-thread-hide-subtree
  2374.            (gnus-summary-hide-all-threads))
  2375.       ;; Show first unread article if requested.
  2376.       (goto-char (point-min))
  2377.       (if (and (not no-article)
  2378.            gnus-auto-select-first
  2379.            (gnus-summary-first-unread-article))
  2380.           ;; Window is configured automatically.
  2381.           ;; Current buffer may be changed as a result of hook
  2382.           ;; evaluation, especially by gnus-summary-rmail-digest
  2383.           ;; command, so we should adjust cursor point carefully.
  2384.           (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
  2385.           (progn
  2386.             ;; Adjust cursor point.
  2387.             (beginning-of-line)
  2388.             (search-forward ":" nil t)))
  2389.         (gnus-configure-windows 'summary)
  2390.         (gnus-pop-to-buffer gnus-summary-buffer)
  2391.         (gnus-summary-set-mode-line)
  2392.         ;; I sometime get confused with the old Article buffer.
  2393.         (if (get-buffer gnus-article-buffer)
  2394. ;; jwz: killing this messes up some window configurations
  2395. ;;        (if (get-buffer-window gnus-article-buffer)
  2396.             (save-excursion
  2397.               (set-buffer gnus-article-buffer)
  2398.               (let ((buffer-read-only nil))
  2399.             (erase-buffer)))
  2400. ;;          (kill-buffer gnus-article-buffer))
  2401.           )
  2402.         ;; Adjust cursor point.
  2403.         (beginning-of-line)
  2404.         (search-forward ":" nil t))
  2405.       ))
  2406.     ;; Cannot select newsgroup GROUP.
  2407.     (if (gnus-gethash group gnus-active-hashtb)
  2408.     (progn
  2409.       ;; If NNTP is used, nntp_access file may not be installed
  2410.       ;; properly.  Otherwise, may be active file problem.
  2411.       (ding)
  2412.       (message
  2413.        (gnus-nntp-message
  2414.         (format "Cannot select %s.  May be security or active file problem." group)))
  2415.       (sit-for 0))
  2416.       ;; Check bogus newsgroups.
  2417.       ;; We must be in Group Mode buffer.
  2418.       (gnus-group-check-bogus-groups))
  2419.     ))
  2420.  
  2421. (defun gnus-summary-prepare ()
  2422.   "Prepare summary list of current newsgroup in Summary buffer."
  2423.   (let ((buffer-read-only nil))
  2424.     ;; Note: The next codes are not actually used because the user who
  2425.     ;; want it can define them in gnus-select-group-hook.
  2426.     ;; Print verbose messages if too many articles are selected.
  2427.     ;;    (and (numberp gnus-large-newsgroup)
  2428.     ;;       (> (length gnus-newsgroup-headers) gnus-large-newsgroup)
  2429.     ;;       (message "Preparing headers..."))
  2430.     (erase-buffer)
  2431.     (gnus-summary-prepare-threads
  2432.      (if gnus-show-threads
  2433.      (gnus-make-threads gnus-newsgroup-headers)
  2434.        gnus-newsgroup-headers) 0)
  2435.     ;; Erase header retrieval message.
  2436.     (message "")
  2437.     ;; Call hooks for modifying Summary buffer.
  2438.     ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
  2439.     (goto-char (point-min))
  2440.     (run-hooks 'gnus-summary-prepare-hook)
  2441.     ))
  2442.  
  2443. ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>
  2444. ;; Subject bug fix by jbw@bigbird.bu.edu (Joe Wells)
  2445.  
  2446. (defun gnus-summary-prepare-threads (threads level &optional parent-subject
  2447.                                                              ;; XEmacs change
  2448.                                                              leader count)
  2449.   "Prepare Summary buffer from THREADS and indentation LEVEL.
  2450. THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).'
  2451. Optional PARENT-SUBJECT specifies the subject of the parent.
  2452. Optional LEADER specifies the current indentation leader.
  2453. Optional COUNT specifies the number of articles threaded so far."
  2454.   (let ((thread nil)
  2455.     (header nil)
  2456.     (number nil)
  2457.     (subject nil)
  2458.     (child-subject nil)
  2459.     (parent-subject (or parent-subject ""))
  2460.     ;; `M Indent NUM: [OPT] SUBJECT'
  2461.     (cntl (format "%%s %%s%%%dd: [%%s] %%s\n"
  2462.               (length (prin1-to-string gnus-newsgroup-end))))
  2463.         ;; XEmacs change
  2464.     (total (length gnus-newsgroup-headers)))
  2465.     (or count (setq count 0))
  2466.     (while threads
  2467.       (setq thread (car threads))
  2468.       (setq threads (cdr threads))
  2469.       (gnus-lazy-message "Formatting Summary... %d%%" (/ count total))
  2470.       (setq count (+ count 100))
  2471.  
  2472.       ;; If thread is a cons, hierarchical threads is given.
  2473.       ;; Otherwise, thread itself is header.
  2474.       (if (consp thread)
  2475.       (setq header (car thread))
  2476.     (setq header thread))
  2477.       ;; Print valid header only.
  2478.       (if (vectorp header)        ;Depends on nntp.el.
  2479.       (progn
  2480.         (setq number (nntp-header-number header))
  2481.         (setq subject (nntp-header-subject header))
  2482.         (setq child-subject (gnus-simplify-subject subject 're-only))
  2483.         (insert
  2484.          (format cntl
  2485.              ;; Read or not.
  2486.              (cond ((memq number gnus-newsgroup-marked)  "-")
  2487.                ((memq number gnus-newsgroup-unreads) " ")
  2488.                (t "D"))
  2489.              ;; Thread level.
  2490.              ;; XEmacs change
  2491.              (if gnus-show-thread-lines
  2492.              (if (zerop level) "" (concat leader " \\_ "))
  2493.                (make-string (* level gnus-thread-indent-level) ? ))
  2494.              ;; Article number.
  2495.              number
  2496.              ;; Optional headers.
  2497.              (or (and gnus-optional-headers
  2498.                   (funcall gnus-optional-headers header)) "")
  2499.              ;; Its subject string.
  2500.              (concat (if (or (zerop level)
  2501.                      (not gnus-thread-hide-subject)
  2502.                      ;; Subject is different from the parent.
  2503.                      (not (string-equal
  2504.                        parent-subject child-subject)))
  2505.                  nil
  2506.                    (make-string (window-width) ? ))
  2507.                  subject)
  2508.              ))
  2509.         ))
  2510.       ;; Print subthreads.
  2511.       (and (consp thread)
  2512.        (cdr thread)
  2513.            ;; XEmacs change
  2514.        (setq count
  2515.          (gnus-summary-prepare-threads
  2516.           (cdr thread) (1+ level) child-subject
  2517.           (if (zerop level)
  2518.               ""
  2519.             (concat leader (if threads " |  " "    ")))
  2520.           count)))
  2521.       ;; XEmacs change
  2522.       (message nil))
  2523.     count))
  2524.  
  2525. ;;(defun gnus-summary-set-mode-line ()
  2526. ;;  "Set Summary mode line string."
  2527. ;;  ;; The value must be a string to escape %-constructs.
  2528. ;;  (let ((subject
  2529. ;;     (if gnus-current-headers
  2530. ;;         (nntp-header-subject gnus-current-headers) gnus-newsgroup-name)))
  2531. ;;    (setq mode-line-buffer-identification
  2532. ;;      (concat "GNUS: "
  2533. ;;          subject
  2534. ;;          ;; Enough spaces to pad subject to 17 positions.
  2535. ;;          (make-string (max 0 (- 17 (length subject))) ? ))))
  2536. ;;  (set-buffer-modified-p t))
  2537.  
  2538. ;; New implementation in gnus 3.14.3
  2539.  
  2540. (defun gnus-summary-set-mode-line ()
  2541.   "Set Summary mode line string.
  2542. If you don't like it, define your own gnus-summary-set-mode-line."
  2543.   (let ((unmarked
  2544.      (- (length gnus-newsgroup-unreads)
  2545.         (length (gnus-intersection
  2546.              gnus-newsgroup-unreads gnus-newsgroup-marked))))
  2547.     (unselected
  2548.      (- (length gnus-newsgroup-unselected)
  2549.         (length (gnus-intersection
  2550.              gnus-newsgroup-unselected gnus-newsgroup-marked)))))
  2551.     (setq mode-line-buffer-identification
  2552.       (list 17
  2553.         (format "GNUS: %s%s %s"
  2554.             gnus-newsgroup-name
  2555.             (if gnus-current-article
  2556.                 (format "/%d" gnus-current-article) "")
  2557.             ;; Basic ideas by tale@pawl.rpi.edu.
  2558.             (cond ((and (zerop unmarked)
  2559.                     (zerop unselected))
  2560.                    "")
  2561.                   ((zerop unselected)
  2562.                    (format "{%d more}" unmarked))
  2563.                   (t
  2564.                    (format "{%d(+%d) more}" unmarked unselected)))
  2565.             ))))
  2566.   (set-buffer-modified-p t))
  2567.  
  2568. ;; GNUS Summary mode command.
  2569.  
  2570. (defun gnus-summary-search-group (&optional backward)
  2571.   "Search for next unread newsgroup.
  2572. If optional argument BACKWARD is non-nil, search backward instead."
  2573.   (save-excursion
  2574.     (set-buffer gnus-group-buffer)
  2575.     (save-excursion
  2576.       ;; We don't want to alter current point of Group mode buffer.
  2577.       (if (gnus-group-search-forward backward nil)
  2578.       (gnus-group-group-name))
  2579.       )))
  2580.  
  2581. ;; XEmacs change: modified this to strip leading and trailing whitespace, 
  2582. ;; and "Part 01" and similar cruft when searching for subjects.
  2583. (defun gnus-summary-search-subject (backward unread subject)
  2584.   "Search for article forward.
  2585. If 1st argument BACKWARD is non-nil, search backward.
  2586. If 2nd argument UNREAD is non-nil, only unread article is selected.
  2587. If 3rd argument SUBJECT is non-nil, the article which has
  2588. the same subject will be searched for."
  2589.   (if (string= subject "")
  2590.       ;; lemcs: reject empty subjects so that C-k on a subjectless message
  2591.       ;; doesn't kill *everything*.
  2592.       (error "empty subject"))
  2593.   (let ((func
  2594.      (if backward
  2595.          (function re-search-backward) (function re-search-forward)))
  2596.     (article nil)
  2597.     ;; We have to take care of hidden lines.
  2598.     (regexp
  2599.      ;; XEmacs change for thread lines, neg numbers: [ \t]+  ->  [^-0-9]*
  2600.      (format "^%s[^-0-9]*\\([-0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s"
  2601.          ;;(if unread " " ".")
  2602.          (cond ((eq unread t) " ") (unread "[- ]") (t "."))
  2603.          (if subject
  2604.              (concat "\\([Rr][Ee]:[ \t]+\\)*"
  2605.                  "\\(v[0-9]+i[0-9]+:[ \t]*\\)?" ; XEmacs addition
  2606.                  (regexp-quote
  2607.                   (progn
  2608.                 (setq subject (gnus-simplify-subject subject))
  2609.                 (if (string= "" subject)
  2610.                     (error "empty subject"))
  2611.                 subject))
  2612.                  ;; Ignore words in parentheses. (XEmacs change)
  2613.                  "\\(\\([ \t]*([^\r\n]*)\\)+[ \t]*\\(\r\\|$\\)\\)?"
  2614.                  ;; Ignore "part" specs (XEmacs)
  2615.                  "\\([, \t]*part[ \t]*[0-9]+.*$\\)?"
  2616.                  )
  2617.            "")
  2618.          )))
  2619.     (if backward
  2620.     (beginning-of-line)
  2621.       (end-of-line))
  2622.     (if (funcall func regexp nil t)
  2623.     (setq article
  2624.           (string-to-int
  2625.            ;; #### would be faster to use read
  2626.            (buffer-substring (match-beginning 1) (match-end 1)))))
  2627.     ;; Adjust cursor point.
  2628.     (beginning-of-line)
  2629.     (search-forward ":" nil t)
  2630.     ;; This is the result.
  2631.     article
  2632.     ))
  2633.  
  2634. (defun gnus-summary-search-forward (&optional unread subject)
  2635.   "Search for article forward.
  2636. If 1st optional argument UNREAD is non-nil, only unread article is selected.
  2637. If 2nd optional argument SUBJECT is non-nil, the article which has
  2638. the same subject will be searched for."
  2639.   (gnus-summary-search-subject nil unread subject))
  2640.  
  2641. (defun gnus-summary-search-backward (&optional unread subject)
  2642.   "Search for article backward.
  2643. If 1st optional argument UNREAD is non-nil, only unread article is selected.
  2644. If 2nd optional argument SUBJECT is non-nil, the article which has
  2645. the same subject will be searched for."
  2646.   (gnus-summary-search-subject t unread subject))
  2647.  
  2648. (defun gnus-summary-article-number ()
  2649.   "Article number around point. If nothing, return current number."
  2650.   (save-excursion
  2651.     (beginning-of-line)
  2652.     ;; XEmacs change for thread lines, neg numbers: [ \t]+  ->  [^-0-9]*
  2653.     (if (looking-at ".[^-0-9]*\\([-0-9]+\\):")
  2654.     (save-excursion
  2655.       (save-restriction
  2656.         ;; jwz: this is faster than string-to-int/buffer-substring
  2657.         (narrow-to-region (match-beginning 1) (match-end 1))
  2658.         (read (current-buffer))))
  2659.       ;; If search fail, return current article number.
  2660.       gnus-current-article
  2661.       )))
  2662.  
  2663. (defun gnus-summary-subject-string ()
  2664.   "Return current subject string or nil if nothing."
  2665.   (save-excursion
  2666.     ;; It is possible to implement this function using
  2667.     ;;  `gnus-summary-article-number' and `gnus-newsgroup-headers'.
  2668.     (beginning-of-line)
  2669.     ;; We have to take care of hidden lines.
  2670.     (if (looking-at
  2671.      ;; XEmacs change for thread lines, neg numbers: [ \t]+  ->  [^-0-9]*
  2672.      ".[^-0-9]*[-0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]")
  2673.     (buffer-substring (match-beginning 1) (match-end 1)))
  2674.     ))
  2675.  
  2676. (defun gnus-summary-goto-subject (article)
  2677.   "Move point to ARTICLE's subject."
  2678.   (interactive
  2679.    (list
  2680.     (string-to-int
  2681.      (completing-read "Article number: "
  2682.               (mapcar
  2683.                (function
  2684.             (lambda (headers)
  2685.               (list
  2686.                (int-to-string (nntp-header-number headers)))))
  2687.                gnus-newsgroup-headers)
  2688.               nil 'require-match))))
  2689.   (let ((current (point)))
  2690.     (goto-char (point-min))
  2691.     ;; XEmacs change for thread lines, neg numbers: [ \t]+  ->  [^-0-9]*
  2692.     (or (and article (re-search-forward (format "^.[^-0-9]*%d:" article)
  2693.                     nil t))
  2694.     (progn (goto-char current) nil))
  2695.     ))
  2696.  
  2697. (defun gnus-summary-recenter ()
  2698.   "Center point in Summary window."
  2699.   ;; Scroll window so as to cursor comes center of Summary window
  2700.   ;;  only when article is displayed.
  2701.   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
  2702.   ;; Recenter only when requested.
  2703.   ;; Subbested by popovich@park.cs.columbia.edu
  2704.   (and gnus-auto-center-summary
  2705.        (get-buffer-window gnus-article-buffer)
  2706.        (< (/ (- (window-height) 1) 2)
  2707.       (count-lines (point) (point-max)))
  2708.        (recenter (/ (- (window-height) 2) 2))))
  2709.  
  2710. ;; Walking around Group mode buffer.
  2711.  
  2712. (defun gnus-summary-jump-to-group (newsgroup)
  2713.   "Move point to NEWSGROUP in Group mode buffer."
  2714.   ;; Keep update point of Group mode buffer if visible.
  2715.   (if (eq (current-buffer)
  2716.       (get-buffer gnus-group-buffer))
  2717.       (save-window-excursion
  2718.     ;; Take care of tree window mode.
  2719.     (if (get-buffer-window gnus-group-buffer)
  2720.         (pop-to-buffer gnus-group-buffer))
  2721.     (gnus-group-jump-to-group newsgroup))
  2722.     (save-excursion
  2723.       ;; Take care of tree window mode.
  2724.       (if (get-buffer-window gnus-group-buffer)
  2725.       (pop-to-buffer gnus-group-buffer)
  2726.     (set-buffer gnus-group-buffer))
  2727.       (gnus-group-jump-to-group newsgroup))))
  2728.  
  2729. (defun gnus-summary-next-group (no-article)
  2730.   "Exit current newsgroup and then select next unread newsgroup.
  2731. If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
  2732.   (interactive "P")
  2733.   ;; Make sure Group mode buffer point is on current newsgroup.
  2734.   (gnus-summary-jump-to-group gnus-newsgroup-name)
  2735.   (let ((group (gnus-summary-search-group)))
  2736.     (if (null group)
  2737.     (progn
  2738.       (message "Exiting %s..." gnus-newsgroup-name)  
  2739.       (gnus-summary-exit)
  2740.       (message ""))
  2741.       (message "Selecting %s..." group)
  2742.       (gnus-summary-exit t)        ;Exit Summary mode temporary.
  2743.       ;; We are now in Group mode buffer.
  2744.       ;; Make sure Group mode buffer point is on GROUP.
  2745.       (gnus-summary-jump-to-group group)
  2746.       (gnus-summary-read-group group nil no-article)
  2747.       (or (eq (current-buffer)
  2748.           (get-buffer gnus-summary-buffer))
  2749.       (eq gnus-auto-select-next t)
  2750.       ;; Expected newsgroup has nothing to read since the articles
  2751.       ;; are marked as read by cross-referencing. So, try next
  2752.       ;; newsgroup. (Make sure we are in Group mode buffer now.)
  2753.       (and (eq (current-buffer)
  2754.            (get-buffer gnus-group-buffer))
  2755.            (gnus-group-group-name)
  2756.            (gnus-summary-read-group
  2757.         (gnus-group-group-name) nil no-article))
  2758.       )
  2759.       )))
  2760.  
  2761. (defun gnus-summary-prev-group (no-article)
  2762.   "Exit current newsgroup and then select previous unread newsgroup.
  2763. If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
  2764.   (interactive "P")
  2765.   ;; Make sure Group mode buffer point is on current newsgroup.
  2766.   (gnus-summary-jump-to-group gnus-newsgroup-name)
  2767.   (let ((group (gnus-summary-search-group t)))
  2768.     (if (null group)
  2769.     (progn
  2770.       (message "Exiting %s..." gnus-newsgroup-name)  
  2771.       (gnus-summary-exit)
  2772.       (message ""))
  2773.       (message "Selecting %s..." group)
  2774.       (gnus-summary-exit t)        ;Exit Summary mode temporary.
  2775.       ;; We are now in Group mode buffer.
  2776.       ;; We have to adjust point of Group mode buffer because current
  2777.       ;; point is moved to next unread newsgroup by exiting.
  2778.       (gnus-summary-jump-to-group group)
  2779.       (gnus-summary-read-group group nil no-article)
  2780.       (or (eq (current-buffer)
  2781.           (get-buffer gnus-summary-buffer))
  2782.       (eq gnus-auto-select-next t)
  2783.       ;; Expected newsgroup has nothing to read since the articles
  2784.       ;; are marked as read by cross-referencing. So, try next
  2785.       ;; newsgroup. (Make sure we are in Group mode buffer now.)
  2786.       (and (eq (current-buffer)
  2787.            (get-buffer gnus-group-buffer))
  2788.            (gnus-summary-search-group t)
  2789.            (gnus-summary-read-group
  2790.         (gnus-summary-search-group t) nil no-article))
  2791.       )
  2792.       )))
  2793.  
  2794. ;; Walking around summary lines.
  2795.  
  2796. (defun gnus-summary-next-subject (n &optional unread)
  2797.   "Go to next N'th summary line.
  2798. If optional argument UNREAD is non-nil, only unread article is selected."
  2799.   (interactive "p")
  2800.   (while (and (> n 1)
  2801.           (gnus-summary-search-forward unread))
  2802.     (setq n (1- n)))
  2803.   (cond ((gnus-summary-search-forward unread)
  2804.      (gnus-summary-recenter))
  2805.     (unread
  2806.      (message "No more unread articles"))
  2807.     (t
  2808.      (message "No more articles"))
  2809.     ))
  2810.  
  2811. (defun gnus-summary-next-unread-subject (n)
  2812.   "Go to next N'th unread summary line."
  2813.   (interactive "p")
  2814.   (gnus-summary-next-subject n t))
  2815.  
  2816. (defun gnus-summary-prev-subject (n &optional unread)
  2817.   "Go to previous N'th summary line.
  2818. If optional argument UNREAD is non-nil, only unread article is selected."
  2819.   (interactive "p")
  2820.   (while (and (> n 1)
  2821.           (gnus-summary-search-backward unread))
  2822.     (setq n (1- n)))
  2823.   (cond ((gnus-summary-search-backward unread)
  2824.      (gnus-summary-recenter))
  2825.     (unread
  2826.      (message "No more unread articles"))
  2827.     (t
  2828.      (message "No more articles"))
  2829.     ))
  2830.  
  2831. (defun gnus-summary-prev-unread-subject (n)
  2832.   "Go to previous N'th unread summary line."
  2833.   (interactive "p")
  2834.   (gnus-summary-prev-subject n t))
  2835.  
  2836. ;; Walking around summary lines with displaying articles.
  2837.  
  2838. (defun gnus-summary-expand-window ()
  2839.   "Expand Summary window to show headers full window."
  2840.   (interactive)
  2841.   (gnus-configure-windows 'summary)
  2842.   (gnus-pop-to-buffer gnus-summary-buffer))
  2843.  
  2844. (defun gnus-summary-display-article (article &optional all-header)
  2845.   "Display ARTICLE in Article buffer."
  2846.   (if (null article)
  2847.       nil
  2848.     (gnus-configure-windows 'article)
  2849.     (gnus-pop-to-buffer gnus-summary-buffer)
  2850.     (gnus-ensure-article-summary article) ; XEmacs (must be before -prepare)
  2851.     (gnus-article-prepare article all-header)
  2852.     (gnus-summary-recenter)
  2853.     (gnus-summary-set-mode-line)
  2854.     (run-hooks 'gnus-select-article-hook)
  2855.     ;; Successfully display article.
  2856.     t
  2857.     ))
  2858.  
  2859. (defun gnus-summary-select-article (&optional all-headers force)
  2860.   "Select the current article.
  2861. Optional first argument ALL-HEADERS is non-nil, show all header fields.
  2862. Optional second argument FORCE is nil, the article is only selected
  2863. again when current header does not match with ALL-HEADERS option."
  2864.   (let ((article (gnus-summary-article-number))
  2865.     (all-headers (not (not all-headers)))) ;Must be T or NIL.
  2866.     (if (or (null gnus-current-article)
  2867.         (/= article gnus-current-article)
  2868.         (and force (not (eq all-headers gnus-have-all-headers))))
  2869.     ;; The selected one is different from that of the current article.
  2870.     (gnus-summary-display-article article all-headers)
  2871.       (gnus-configure-windows 'article)
  2872.       (pop-to-buffer gnus-summary-buffer))
  2873.     ))
  2874.  
  2875. (defun gnus-summary-set-current-mark (&optional current-mark)
  2876.   "Put `+' at the current article.
  2877. Optional argument specifies CURRENT-MARK instead of `+'."
  2878.   (save-excursion
  2879.     (set-buffer gnus-summary-buffer)
  2880.     (let ((buffer-read-only nil))
  2881.       (goto-char (point-min))
  2882.       ;; First of all clear mark at last article.
  2883.       ;; XEmacs change for thread lines, neg numbers: [ \t]+  ->  [^-0-9]*
  2884.       (if (re-search-forward "^.[^-0-9]*[-0-9]+:[^ \t]" nil t)
  2885.       (progn
  2886.         (delete-char -1)
  2887.         (insert " ")
  2888.         (goto-char (point-min))))
  2889.       ;; XEmacs change for thread lines, neg numbers: [ \t]+  ->  [^-0-9]*
  2890.       (if (re-search-forward (format "^.[^-0-9]*%d:" gnus-current-article)
  2891.                  nil t)
  2892.       (progn
  2893.         (delete-char 1)
  2894.         (insert (or current-mark "+"))))
  2895.       )))
  2896.  
  2897. ;;(defun gnus-summary-next-article (unread &optional subject)
  2898. ;;  "Select article after current one.
  2899. ;;If argument UNREAD is non-nil, only unread article is selected."
  2900. ;;  (interactive "P")
  2901. ;;  (cond ((gnus-summary-display-article
  2902. ;;      (gnus-summary-search-forward unread subject)))
  2903. ;;    (unread
  2904. ;;     (message "No more unread articles"))
  2905. ;;    (t
  2906. ;;     (message "No more articles"))
  2907. ;;    ))
  2908.  
  2909. (defun gnus-summary-next-article (unread &optional subject)
  2910.   "Select article after current one.
  2911. If argument UNREAD is non-nil, only unread article is selected."
  2912.   (interactive "P")
  2913.   (let ((header nil))
  2914.     (cond ((gnus-summary-display-article
  2915.         (gnus-summary-search-forward unread subject)))
  2916.       ((and subject
  2917.         gnus-auto-select-same
  2918.         (gnus-set-difference gnus-newsgroup-unreads
  2919.                      gnus-newsgroup-marked)
  2920.         (memq this-command
  2921.               '(gnus-summary-next-unread-article
  2922.             gnus-summary-next-page
  2923.             gnus-summary-kill-same-subject-and-select
  2924.             ;;gnus-summary-next-article
  2925.             ;;gnus-summary-next-same-subject
  2926.             ;;gnus-summary-next-unread-same-subject
  2927.             )))
  2928.        ;; Wrap article pointer if there are unread articles.
  2929.        ;; Hook function, such as gnus-summary-rmail-digest, may
  2930.        ;; change current buffer, so need check.
  2931.        (let ((buffer (current-buffer))
  2932.          (last-point (point)))
  2933.          ;; No more articles with same subject, so jump to the first
  2934.          ;; unread article.
  2935.          (gnus-summary-first-unread-article)
  2936.          ;;(and (eq buffer (current-buffer))
  2937.          ;;    (= (point) last-point)
  2938.          ;;    ;; Ignore given SUBJECT, and try again.
  2939.          ;;    (gnus-summary-next-article unread nil))
  2940.          (and (eq buffer (current-buffer))
  2941.           (< (point) last-point)
  2942.           (message "Wrapped"))
  2943.          ))
  2944.       ((and gnus-auto-extend-newsgroup
  2945.         (not unread)        ;Not unread only
  2946.         (not subject)        ;Only if subject is not specified.
  2947.         (setq header (gnus-more-header-forward)))
  2948.        ;; Extend to next article if possible.
  2949.        ;; Basic ideas by himacdonald@watdragon.waterloo.edu
  2950.        (gnus-extend-newsgroup header nil)
  2951.        ;; Threads feature must be turned off.
  2952.        (let ((buffer-read-only nil))
  2953.          (goto-char (point-max))
  2954.          (gnus-summary-prepare-threads (list header) 0))
  2955.        (gnus-summary-goto-article gnus-newsgroup-end))
  2956.       (t
  2957.        ;; Select next newsgroup automatically if requested.
  2958.        (let ((this-event
  2959.           (if (fboundp 'next-command-event) ; XEmacs
  2960.               last-command-event
  2961.             (string-to-char (this-command-keys))))
  2962.          (group (gnus-summary-search-group))
  2963.          (auto-select
  2964.           (and gnus-auto-select-next
  2965.                ;;(null (gnus-set-difference gnus-newsgroup-unreads
  2966.                ;;                gnus-newsgroup-marked))
  2967.                (memq this-command
  2968.                  '(gnus-summary-next-unread-article
  2969.                    gnus-summary-next-article
  2970.                    gnus-summary-next-page
  2971.                    gnus-summary-next-same-subject
  2972.                    gnus-summary-next-unread-same-subject
  2973.                    gnus-summary-kill-same-subject
  2974.                    gnus-summary-kill-same-subject-and-select
  2975.                    ))
  2976.                ;; Ignore characters typed ahead.
  2977.                (not (input-pending-p))
  2978.                )))
  2979.          (message "No more%s articles%s"
  2980.               (if unread " unread" "")
  2981.               (if (and auto-select
  2982.                    (not (eq gnus-auto-select-next 'quietly)))
  2983.               (if group
  2984.                   (format " (Type %s for %s [%d])"
  2985.                       (key-description
  2986.                        (if (fboundp 'next-command-event)
  2987.                        ;; XEmacs
  2988.                        this-event
  2989.                      (char-to-string this-event)))
  2990.                       group
  2991.                       (nth 1 (gnus-gethash group
  2992.                                gnus-unread-hashtb)))
  2993.                 (format " (Type %s to exit %s)"
  2994.                     (key-description
  2995.                      (if (fboundp 'next-command-event) ; XEmacs
  2996.                      this-event
  2997.                        (char-to-string this-event)))
  2998.                     gnus-newsgroup-name
  2999.                     ))
  3000.             ""))
  3001.          ;; Select next unread newsgroup automagically.
  3002.          (cond ((and auto-select
  3003.              (eq gnus-auto-select-next 'quietly))
  3004.             ;; Select quietly.
  3005.             (gnus-summary-next-group nil))
  3006.            (auto-select
  3007.             ;; Confirm auto selection.
  3008.             (if (fboundp 'next-command-event) ; XEmacs
  3009.             (let ((next-event (next-command-event)))
  3010.               (if (equal this-event next-event)
  3011.                   (gnus-summary-next-group nil)
  3012.                 (setq unread-command-event next-event)))
  3013.               (let ((next-event (read-char)))
  3014.             (if (= this-event next-event)
  3015.                 (gnus-summary-next-group nil)
  3016.               (setq unread-command-char next-event)))))
  3017.            )
  3018.          ))
  3019.       )))
  3020.  
  3021. (defun gnus-summary-next-unread-article ()
  3022.   "Select unread article after current one."
  3023.   (interactive)
  3024.   (gnus-summary-next-article t (and gnus-auto-select-same
  3025.                     (gnus-summary-subject-string))))
  3026.  
  3027. (defun gnus-summary-prev-article (unread &optional subject)
  3028.   "Select article before current one.
  3029. If argument UNREAD is non-nil, only unread article is selected."
  3030.   (interactive "P")
  3031.   (let ((header nil))
  3032.     (cond ((gnus-summary-display-article
  3033.         (gnus-summary-search-backward unread subject)))
  3034.       ((and subject
  3035.         gnus-auto-select-same
  3036.         (gnus-set-difference gnus-newsgroup-unreads
  3037.                      gnus-newsgroup-marked)
  3038.         (memq this-command
  3039.               '(gnus-summary-prev-unread-article
  3040.             ;;gnus-summary-prev-page
  3041.             ;;gnus-summary-prev-article
  3042.             ;;gnus-summary-prev-same-subject
  3043.             ;;gnus-summary-prev-unread-same-subject
  3044.             )))
  3045.        ;; Ignore given SUBJECT, and try again.
  3046.        (gnus-summary-prev-article unread nil))
  3047.       (unread
  3048.        (message "No more unread articles"))
  3049.       ((and gnus-auto-extend-newsgroup
  3050.         (not subject)        ;Only if subject is not specified.
  3051.         (setq header (gnus-more-header-backward)))
  3052.        ;; Extend to previous article if possible.
  3053.        ;; Basic ideas by himacdonald@watdragon.waterloo.edu
  3054.        (gnus-extend-newsgroup header t)
  3055.        (let ((buffer-read-only nil))
  3056.          (goto-char (point-min))
  3057.          (gnus-summary-prepare-threads (list header) 0))
  3058.        (gnus-summary-goto-article gnus-newsgroup-begin))
  3059.       (t
  3060.        (message "No more articles"))
  3061.       )))
  3062.  
  3063. (defun gnus-summary-prev-unread-article ()
  3064.   "Select unred article before current one."
  3065.   (interactive)
  3066.   (gnus-summary-prev-article t (and gnus-auto-select-same
  3067.                     (gnus-summary-subject-string))))
  3068.  
  3069. (defun gnus-summary-next-page (lines)
  3070.   "Show next page of selected article.
  3071. If end of article, select next article.
  3072. Argument LINES specifies lines to be scrolled up."
  3073.   (interactive "P")
  3074.   (let ((article (gnus-summary-article-number))
  3075.     (endp nil))
  3076.     (if (or (null gnus-current-article)
  3077.         (/= article gnus-current-article))
  3078.     ;; Selected subject is different from current article's.
  3079.     (gnus-summary-display-article article)
  3080.       (gnus-configure-windows 'article)
  3081.       (gnus-pop-to-buffer gnus-summary-buffer)
  3082.       (gnus-eval-in-buffer-window gnus-article-buffer
  3083.     (setq endp (gnus-article-next-page lines)))
  3084.       (cond ((and endp lines)
  3085.          (message "End of message"))
  3086.         ((and endp (null lines))
  3087.          (gnus-summary-next-unread-article)))
  3088.       )))
  3089.  
  3090. (defun gnus-summary-prev-page (lines)
  3091.   "Show previous page of selected article.
  3092. Argument LINES specifies lines to be scrolled down."
  3093.   (interactive "P")
  3094.   (let ((article (gnus-summary-article-number)))
  3095.     (if (or (null gnus-current-article)
  3096.         (/= article gnus-current-article))
  3097.     ;; Selected subject is different from current article's.
  3098.     (gnus-summary-display-article article)
  3099.       (gnus-configure-windows 'article)
  3100.       (gnus-pop-to-buffer gnus-summary-buffer)
  3101.       (gnus-eval-in-buffer-window gnus-article-buffer
  3102.     (gnus-article-prev-page lines))
  3103.       )))
  3104.  
  3105. (defun gnus-summary-scroll-up (lines)
  3106.   "Scroll up (or down) one line current article.
  3107. Argument LINES specifies lines to be scrolled up (or down if negative)."
  3108.   (interactive "p")
  3109.   (gnus-summary-select-article)
  3110.   (gnus-eval-in-buffer-window gnus-article-buffer
  3111.     (cond ((> lines 0)
  3112.        (if (gnus-article-next-page lines)
  3113.            (message "End of message")))
  3114.       ((< lines 0)
  3115.        (gnus-article-prev-page (- 0 lines))))
  3116.     ))
  3117.  
  3118. (defun gnus-summary-next-same-subject ()
  3119.   "Select next article which has the same subject as current one."
  3120.   (interactive)
  3121.   (gnus-summary-next-article nil (gnus-summary-subject-string)))
  3122.  
  3123. (defun gnus-summary-prev-same-subject ()
  3124.   "Select previous article which has the same subject as current one."
  3125.   (interactive)
  3126.   (gnus-summary-prev-article nil (gnus-summary-subject-string)))
  3127.  
  3128. (defun gnus-summary-next-unread-same-subject ()
  3129.   "Select next unread article which has the same subject as current one."
  3130.   (interactive)
  3131.   (gnus-summary-next-article t (gnus-summary-subject-string)))
  3132.  
  3133. (defun gnus-summary-prev-unread-same-subject ()
  3134.   "Select previous unread article which has the same subject as current one."
  3135.   (interactive)
  3136.   (gnus-summary-prev-article t (gnus-summary-subject-string)))
  3137.  
  3138. (defun gnus-summary-refer-parent-article (child)
  3139.   "Refer parent article of current article.
  3140. If a prefix argument CHILD is non-nil, go back to the child article
  3141. using internally maintained articles history.
  3142. NOTE: This command may not work with nnspool.el."
  3143.   (interactive "P")
  3144.   (gnus-summary-select-article)        ;XEmacs: no longer need all headers.
  3145.   (let ((referenced-id nil))        ;Message-id of parent or child article.
  3146.     (if child
  3147.     ;; Go back to child article using history.
  3148.     (gnus-summary-refer-article nil)
  3149.       (gnus-eval-in-buffer-window gnus-article-buffer
  3150.     ;; Look for parent Message-ID.
  3151.     ;; XEmacs: we *can* use gnus-current-headers to get references now.
  3152.     (let ((references (nntp-header-references gnus-current-headers)))
  3153.       ;; Get the last message-id in the references.
  3154.       (and references
  3155.            (string-match "\\(<[^<>]+>\\)[^>]*\\'" references)
  3156.            (setq referenced-id
  3157.              (substring references
  3158.                 (match-beginning 1) (match-end 1))))
  3159.       ))
  3160.       (if (stringp referenced-id)
  3161.       (gnus-summary-refer-article referenced-id)
  3162.     (error "No more parents"))
  3163.       )))
  3164.  
  3165. (defun gnus-summary-refer-article (message-id)
  3166.   "Refer article specified by MESSAGE-ID.
  3167. If the MESSAGE-ID is nil or an empty string, Message-ID is poped from
  3168. internally maintained articles history.
  3169. NOTE: This command may not work with nnspool.el nor mhspool.el."
  3170.   (interactive "sMessage-ID: ")
  3171.   ;; Make sure that this command depends on the fact that article
  3172.   ;; related information is not updated when an article is retrieved
  3173.   ;; by Message-ID.
  3174.   ;;(gnus-summary-select-article)    ;XEmacs: no longer need all headers.
  3175.   (if (and (stringp message-id)
  3176.        (> (length message-id) 0))
  3177.       (gnus-eval-in-buffer-window gnus-article-buffer
  3178.     ;; Construct the correct Message-ID if necessary.
  3179.     ;; Suggested by tale@pawl.rpi.edu.
  3180.     (or (string-match "^<" message-id)
  3181.         (setq message-id (concat "<" message-id)))
  3182.     (or (string-match ">$" message-id)
  3183.         (setq message-id (concat message-id ">")))
  3184.     ;; Push current message-id on history.
  3185.     ;; jwz: even if we're looking at a parent or referred article,
  3186.     ;; we can use gnus-current-headers; that's fixed.
  3187.     (let ((current (nntp-header-id gnus-current-headers)))
  3188.       (or (equal current message-id) ;Nothing to do.
  3189.           (equal current (car gnus-current-history))
  3190.           (setq gnus-current-history
  3191.             (cons current gnus-current-history))))
  3192.     )
  3193.     ;; Pop message-id from history.
  3194.     (setq message-id (car gnus-current-history))
  3195.     (setq gnus-current-history (cdr gnus-current-history)))
  3196.   (if (stringp message-id)
  3197.       ;; Retrieve article by message-id.  This may not work with
  3198.       ;; nnspool nor mhspool.
  3199.  
  3200.       ;; changed by jwz
  3201.       ;; Instead of simply "preparing" the article (filling in the *Article*
  3202.       ;; buffer and nothing more) do a full display, meaning configure the
  3203.       ;; windows, run the hooks, and make sure there's a summary line for it.
  3204.       ;;      (gnus-article-prepare message-id t)
  3205.       (progn
  3206.     (gnus-summary-display-article message-id)
  3207.     (gnus-summary-select-article))
  3208.     (error "No such references"))
  3209.   )
  3210.  
  3211. (defun gnus-summary-next-digest (nth)
  3212.   "Move to head of NTH next digested message."
  3213.   (interactive "p")
  3214.   (gnus-summary-select-article)
  3215.   (gnus-eval-in-buffer-window gnus-article-buffer
  3216.     (gnus-article-next-digest (or nth 1))
  3217.     ))
  3218.  
  3219. (defun gnus-summary-prev-digest (nth)
  3220.   "Move to head of NTH previous digested message."
  3221.   (interactive "p")
  3222.   (gnus-summary-select-article)
  3223.   (gnus-eval-in-buffer-window gnus-article-buffer
  3224.     (gnus-article-prev-digest (or nth 1))
  3225.     ))
  3226.  
  3227. (defun gnus-summary-first-unread-article ()
  3228.   "Select first unread article. Return non-nil if successfully selected."
  3229.   (interactive)
  3230.   (let ((begin (point)))
  3231.     (goto-char (point-min))
  3232.     ;; XEmacs change for thread lines, neg numbers: [ \t]+  ->  [^-0-9]*
  3233.     (if (re-search-forward "^ [^-0-9]*[-0-9]+:" nil t)
  3234.     (gnus-summary-display-article (gnus-summary-article-number))
  3235.       ;; If there is no unread articles, stay there.
  3236.       (goto-char begin)
  3237.       ;;(gnus-summary-display-article (gnus-summary-article-number))
  3238.       (message "No more unread articles")
  3239.       nil
  3240.       )
  3241.     ))
  3242.  
  3243. (defun gnus-summary-isearch-article ()
  3244.   "Do incremental search forward on current article."
  3245.   (interactive)
  3246.   (gnus-summary-select-article)
  3247.   (gnus-eval-in-buffer-window gnus-article-buffer
  3248.                   (isearch-forward)))
  3249.  
  3250. (defun gnus-summary-search-article-forward (regexp)
  3251.   "Search for an article containing REGEXP forward.
  3252. gnus-select-article-hook is not called during the search."
  3253.   (interactive
  3254.    (list (read-string
  3255.       (concat "Search forward (regexp): "
  3256.           (if gnus-last-search-regexp
  3257.               (concat "(default " gnus-last-search-regexp ") "))))))
  3258.   (if (string-equal regexp "")
  3259.       (setq regexp (or gnus-last-search-regexp ""))
  3260.     (setq gnus-last-search-regexp regexp))
  3261.   (if (gnus-summary-search-article regexp nil)
  3262.       (gnus-eval-in-buffer-window gnus-article-buffer
  3263.     (recenter 0)
  3264.     ;;(sit-for 1)
  3265.     )
  3266.     (error "Search failed: \"%s\"" regexp)
  3267.     ))
  3268.  
  3269. (defun gnus-summary-search-article-backward (regexp)
  3270.   "Search for an article containing REGEXP backward.
  3271. gnus-select-article-hook is not called during the search."
  3272.   (interactive
  3273.    (list (read-string
  3274.       (concat "Search backward (regexp): "
  3275.           (if gnus-last-search-regexp
  3276.               (concat "(default " gnus-last-search-regexp ") "))))))
  3277.   (if (string-equal regexp "")
  3278.       (setq regexp (or gnus-last-search-regexp ""))
  3279.     (setq gnus-last-search-regexp regexp))
  3280.   (if (gnus-summary-search-article regexp t)
  3281.       (gnus-eval-in-buffer-window gnus-article-buffer
  3282.     (recenter 0)
  3283.     ;;(sit-for 1)
  3284.     )
  3285.     (error "Search failed: \"%s\"" regexp)
  3286.     ))
  3287.  
  3288. (defun gnus-summary-search-article (regexp &optional backward)
  3289.   "Search for an article containing REGEXP.
  3290. Optional argument BACKWARD means do search for backward.
  3291. gnus-select-article-hook is not called during the search."
  3292.   (let ((gnus-select-article-hook nil)    ;Disable hook.
  3293.     (gnus-mark-article-hook nil)    ;Inhibit marking as read.
  3294.     (re-search
  3295.      (if backward
  3296.          (function re-search-backward) (function re-search-forward)))
  3297.     (found nil)
  3298.     (last nil))
  3299.     ;; Hidden thread subtrees must be searched for ,too.
  3300.     (gnus-summary-show-all-threads)
  3301.     ;; First of all, search current article.
  3302.     ;; We don't want to read article again from NNTP server nor reset
  3303.     ;; current point.
  3304.     (gnus-summary-select-article)
  3305.     (message "Searching article: %d..." gnus-current-article)
  3306.     (setq last gnus-current-article)
  3307.     (gnus-eval-in-buffer-window gnus-article-buffer
  3308.       (save-restriction
  3309.     (widen)
  3310.     ;; Begin search from current point.
  3311.     (setq found (funcall re-search regexp nil t))))
  3312.     ;; Then search next articles.
  3313.     (while (and (not found)
  3314.         (gnus-summary-display-article 
  3315.          (gnus-summary-search-subject backward nil nil)))
  3316.       (message "Searching article: %d..." gnus-current-article)
  3317.       (gnus-eval-in-buffer-window gnus-article-buffer
  3318.     (save-restriction
  3319.       (widen)
  3320.       (goto-char (if backward (point-max) (point-min)))
  3321.       (setq found (funcall re-search regexp nil t)))
  3322.     ))
  3323.     (message "")
  3324.     ;; Adjust article pointer.
  3325.     (or (eq last gnus-current-article)
  3326.     (setq gnus-last-article last))
  3327.     ;; Return T if found such article.
  3328.     found
  3329.     ))
  3330.  
  3331. (defun gnus-summary-execute-command (field regexp command &optional backward)
  3332.   "If FIELD of article header matches REGEXP, execute a COMMAND string.
  3333. If FIELD is an empty string (or nil), entire article body is searched for.
  3334. If optional (prefix) argument BACKWARD is non-nil, do backward instead."
  3335.   (interactive
  3336.    (list (let ((completion-ignore-case t))
  3337.        (completing-read "Field name: "
  3338.                 '(("Number")("Subject")("From")
  3339.                   ("Lines")("Date")("Id")
  3340.                   ("Xref")("References"))
  3341.                 nil 'require-match))
  3342.      (read-string "Regexp: ")
  3343.      (read-key-sequence "Command: ")
  3344.      current-prefix-arg))
  3345.   ;; Hidden thread subtrees must be searched for ,too.
  3346.   (gnus-summary-show-all-threads)
  3347.   ;; We don't want to change current point nor window configuration.
  3348.   (save-excursion
  3349.     (save-window-excursion
  3350.       (message "Executing %s..." (key-description command))
  3351.       ;; We'd like to execute COMMAND interactively so as to give arguments.
  3352.       (gnus-execute field regexp
  3353.             (` (lambda ()
  3354.              (call-interactively '(, (key-binding command)))))
  3355.             backward)
  3356.       (message "Executing %s... done" (key-description command)))))
  3357.  
  3358. (defun gnus-summary-beginning-of-article ()
  3359.   "Go to beginning of article body"
  3360.   (interactive)
  3361.   (gnus-summary-select-article)
  3362.   (gnus-eval-in-buffer-window gnus-article-buffer
  3363.     (widen)
  3364.     (beginning-of-buffer)
  3365.     (if gnus-break-pages
  3366.     (gnus-narrow-to-page))
  3367.     ))
  3368.  
  3369. (defun gnus-summary-end-of-article ()
  3370.   "Go to end of article body"
  3371.   (interactive)
  3372.   (gnus-summary-select-article)
  3373.   (gnus-eval-in-buffer-window gnus-article-buffer
  3374.     (widen)
  3375.     (end-of-buffer)
  3376.     (if gnus-break-pages
  3377.     (gnus-narrow-to-page))
  3378.     ))
  3379.  
  3380. (defun gnus-summary-goto-article (article &optional all-headers)
  3381.   "Read ARTICLE if exists.
  3382. Optional argument ALL-HEADERS means all headers are shown."
  3383.   (interactive
  3384.    (list
  3385.     (string-to-int
  3386.      (completing-read "Article number: "
  3387.               (mapcar
  3388.                (function
  3389.             (lambda (headers)
  3390.               (list
  3391.                (int-to-string (nntp-header-number headers)))))
  3392.                gnus-newsgroup-headers)
  3393.               nil 'require-match))))
  3394.   (if (gnus-summary-goto-subject article)
  3395.       (gnus-summary-display-article article all-headers)))
  3396.  
  3397. (defun gnus-summary-goto-last-article ()
  3398.   "Go to last subject line."
  3399.   (interactive)
  3400.   (if gnus-last-article
  3401.       (gnus-summary-goto-article gnus-last-article)))
  3402.  
  3403. (defun gnus-summary-show-article ()
  3404.   "Force to show current article."
  3405.   (interactive)
  3406.   ;; The following is a trick to force to read the current article again.
  3407.   (setq gnus-have-all-headers (not gnus-have-all-headers))
  3408.   (gnus-summary-select-article (not gnus-have-all-headers) t))
  3409.  
  3410. (defun gnus-summary-toggle-header (arg)
  3411.   "Show original header if pruned header currently shown, or vice versa.
  3412. With arg, show original header iff arg is positive."
  3413.   (interactive "P")
  3414.   ;; Variable gnus-show-all-headers must be NIL to toggle really.
  3415.   (let ((gnus-show-all-headers nil)
  3416.     (all-headers
  3417.      (if (null arg) (not gnus-have-all-headers)
  3418.        (> (prefix-numeric-value arg) 0))))
  3419.     (gnus-summary-select-article all-headers t)))
  3420.  
  3421. (defun gnus-summary-show-all-headers ()
  3422.   "Show original article header."
  3423.   (interactive)
  3424.   (gnus-summary-select-article t t))
  3425.  
  3426. (defun gnus-summary-toggle-mime (arg)
  3427.   "Toggle MIME processing.
  3428. With arg, turn MIME processing on iff arg is positive."
  3429.   (interactive "P")
  3430.   (setq gnus-show-mime
  3431.     (if (null arg) (not gnus-show-mime)
  3432.       (> (prefix-numeric-value arg) 0)))
  3433.   ;; The following is a trick to force to read the current article again.
  3434.   (setq gnus-have-all-headers (not gnus-have-all-headers))
  3435.   (gnus-summary-select-article (not gnus-have-all-headers) t))
  3436.  
  3437. (defun gnus-summary-stop-page-breaking ()
  3438.   "Stop page breaking by linefeed temporary (Widen article buffer)."
  3439.   (interactive)
  3440.   (gnus-summary-select-article)
  3441.   (gnus-eval-in-buffer-window gnus-article-buffer
  3442.     (widen)
  3443.     ))
  3444.  
  3445. (defun gnus-summary-kill-same-subject-and-select (unmark)
  3446.   "Mark articles which has the same subject as read, and then select next.
  3447. If argument UNMARK is positive, remove any kinds of marks.
  3448. If argument UNMARK is negative, mark articles as unread instead."
  3449.   (interactive "P")
  3450.   (if unmark
  3451.       (setq unmark (prefix-numeric-value unmark)))
  3452.   (let ((count
  3453.      (gnus-summary-mark-same-subject
  3454.       (gnus-summary-subject-string) unmark)))
  3455.     ;; Select next unread article. If auto-select-same mode, should
  3456.     ;; select the first unread article.
  3457.     (gnus-summary-next-article t (and gnus-auto-select-same
  3458.                       (gnus-summary-subject-string)))
  3459.     (message "%d articles are marked as %s"
  3460.          count (if unmark "unread" "read"))
  3461.     ))
  3462.  
  3463. (defun gnus-summary-kill-same-subject (unmark)
  3464.   "Mark articles which has the same subject as read. 
  3465. If argument UNMARK is positive, remove any kinds of marks.
  3466. If argument UNMARK is negative, mark articles as unread instead."
  3467.   (interactive "P")
  3468.   (if unmark
  3469.       (setq unmark (prefix-numeric-value unmark)))
  3470.   (let ((count
  3471.      (gnus-summary-mark-same-subject
  3472.       (gnus-summary-subject-string) unmark)))
  3473.     ;; If marked as read, go to next unread subject.
  3474.     (if (null unmark)
  3475.     ;; Go to next unread subject.
  3476.     (gnus-summary-next-subject 1 t))
  3477.     (message "%d articles are marked as %s"
  3478.          count (if unmark "unread" "read"))
  3479.     ))
  3480.  
  3481. (defun gnus-summary-mark-same-subject (subject &optional unmark)
  3482.   "Mark articles with same SUBJECT as read, and return marked number.
  3483. If optional argument UNMARK is positive, remove any kinds of marks.
  3484. If optional argument UNMARK is negative, mark articles as unread instead."
  3485.   (let ((count 1))
  3486.     (save-excursion
  3487.       (cond ((null unmark)
  3488.          (gnus-summary-mark-as-read nil "K"))
  3489.         ((> unmark 0)
  3490.          (gnus-summary-mark-as-unread nil t))
  3491.         (t
  3492.          (gnus-summary-mark-as-unread)))
  3493.       (while (and subject
  3494.           (gnus-summary-search-forward nil subject))
  3495.     (cond ((null unmark)
  3496.            (gnus-summary-mark-as-read nil "K"))
  3497.           ((> unmark 0)
  3498.            (gnus-summary-mark-as-unread nil t))
  3499.           (t
  3500.            (gnus-summary-mark-as-unread)))
  3501.     (setq count (1+ count))
  3502.     ))
  3503.     ;; Hide killed thread subtrees.  Does not work properly always.
  3504.     ;;(and (null unmark)
  3505.     ;;     gnus-thread-hide-killed
  3506.     ;;       (gnus-summary-hide-thread))
  3507.     ;; Return number of articles marked as read.
  3508.     count
  3509.     ))
  3510.  
  3511. (defun gnus-summary-mark-as-unread-forward (count)
  3512.   "Mark current article as unread, and then go forward.
  3513. Argument COUNT specifies number of articles marked as unread."
  3514.   (interactive "p")
  3515.   (while (> count 0)
  3516.     (gnus-summary-mark-as-unread nil nil)
  3517.     (gnus-summary-next-subject 1 nil)
  3518.     (setq count (1- count))))
  3519.  
  3520. (defun gnus-summary-mark-as-unread-backward (count)
  3521.   "Mark current article as unread, and then go backward.
  3522. Argument COUNT specifies number of articles marked as unread."
  3523.   (interactive "p")
  3524.   (while (> count 0)
  3525.     (gnus-summary-mark-as-unread nil nil)
  3526.     (gnus-summary-prev-subject 1 nil)
  3527.     (setq count (1- count))))
  3528.  
  3529. (defun gnus-summary-mark-as-unread (&optional article clear-mark)
  3530.   "Mark current article as unread.
  3531. Optional 1st argument ARTICLE specifies article number to be marked as unread.
  3532. Optional 2nd argument CLEAR-MARK remove any kinds of mark."
  3533.   (save-excursion
  3534.     (set-buffer gnus-summary-buffer)
  3535.     ;; First of all, show hidden thread subtrees.
  3536.     (gnus-summary-show-thread)
  3537.     (let* ((buffer-read-only nil)
  3538.        (current (gnus-summary-article-number))
  3539.        (article (or article current)))
  3540.       (gnus-mark-article-as-unread article clear-mark)
  3541.       (if (or (eq article current)
  3542.           (gnus-summary-goto-subject article))
  3543.       (progn
  3544.         (beginning-of-line)
  3545.         (delete-char 1)
  3546.         (insert (if clear-mark " " "-"))))
  3547.       )))
  3548.  
  3549. (defun gnus-summary-mark-as-read-forward (count)
  3550.   "Mark current article as read, and then go forward.
  3551. Argument COUNT specifies number of articles marked as read"
  3552.   (interactive "p")
  3553.   (while (> count 0)
  3554.     (gnus-summary-mark-as-read)
  3555.     (gnus-summary-next-subject 1 'unread-only)
  3556.     (setq count (1- count))))
  3557.  
  3558. (defun gnus-summary-mark-as-read-backward (count)
  3559.   "Mark current article as read, and then go backward.
  3560. Argument COUNT specifies number of articles marked as read"
  3561.   (interactive "p")
  3562.   (while (> count 0)
  3563.     (gnus-summary-mark-as-read)
  3564.     (gnus-summary-prev-subject 1 'unread-only)
  3565.     (setq count (1- count))))
  3566.  
  3567. (defun gnus-summary-mark-as-read (&optional article mark)
  3568.   "Mark current article as read.
  3569. Optional 1st argument ARTICLE specifies article number to be marked as read.
  3570. Optional 2nd argument MARK specifies a string inserted at beginning of line.
  3571. Any kind of string (length 1) except for a space and `-' is ok."
  3572.   (save-excursion
  3573.     (set-buffer gnus-summary-buffer)
  3574.     ;; First of all, show hidden thread subtrees.
  3575.     (gnus-summary-show-thread)
  3576.     (let* ((buffer-read-only nil)
  3577.        (mark (or mark "D"))        ;Default mark is `D'.
  3578.        (current (gnus-summary-article-number))
  3579.        (article (or article current)))
  3580.       (gnus-mark-article-as-read article)
  3581.       (if (or (eq article current)
  3582.           (gnus-summary-goto-subject article))
  3583.       (progn
  3584.         (beginning-of-line)
  3585.         (delete-char 1)
  3586.         (insert mark)))
  3587.       )))
  3588.  
  3589. (defun gnus-summary-clear-mark-forward (count)
  3590.   "Remove current article's mark, and go forward.
  3591. Argument COUNT specifies number of articles unmarked"
  3592.   (interactive "p")
  3593.   (while (> count 0)
  3594.     (gnus-summary-mark-as-unread nil t)
  3595.     (gnus-summary-next-subject 1 nil)
  3596.     (setq count (1- count))))
  3597.  
  3598. (defun gnus-summary-clear-mark-backward (count)
  3599.   "Remove current article's mark, and go backward.
  3600. Argument COUNT specifies number of articles unmarked"
  3601.   (interactive "p")
  3602.   (while (> count 0)
  3603.     (gnus-summary-mark-as-unread nil t)
  3604.     (gnus-summary-prev-subject 1 nil)
  3605.     (setq count (1- count))))
  3606.  
  3607. (defun gnus-summary-delete-marked-as-read ()
  3608.   "Delete lines which is marked as read."
  3609.   (interactive)
  3610.   ;; changed by jwz to only delete lines marked with D, K, or X, to avoid
  3611.   ;; losing marks added by gnus-mark.  (Usually @, but possibly others.)
  3612.   (if (save-excursion
  3613.     (goto-char (point-min))
  3614.     (not (re-search-forward "^[^DKX]" nil t)))
  3615.       ;; It is not such a good idea to make the buffer empty.
  3616.       (message "All articles are marked as read")
  3617.     (let ((buffer-read-only nil))
  3618.       (save-excursion
  3619.     (goto-char (point-min))
  3620.     (delete-matching-lines "^[DKX]"))
  3621.       ;; Adjust point.
  3622.       (if (eobp)
  3623.       (gnus-summary-prev-subject 1)
  3624.     (beginning-of-line)
  3625.     (search-forward ":" nil t)))))
  3626.  
  3627. (defun gnus-summary-delete-marked-with (marks)
  3628.   "Delete lines which are marked with MARKS (e.g. \"DK\")."
  3629.   (interactive "sMarks: ")
  3630.   (let ((buffer-read-only nil))
  3631.     (save-excursion
  3632.       (goto-char (point-min))
  3633.       (delete-matching-lines (concat "^[" marks "]")))
  3634.     ;; Adjust point.
  3635.     (or (zerop (buffer-size))
  3636.     (if (eobp)
  3637.         (gnus-summary-prev-subject 1)
  3638.       (beginning-of-line)
  3639.       (search-forward ":" nil t)))
  3640.     ))
  3641.  
  3642. ;; Thread-based commands.
  3643.  
  3644. (defun gnus-summary-toggle-threads (arg)
  3645.   "Toggle showing conversation threads.
  3646. With arg, turn showing conversation threads on iff arg is positive."
  3647.   (interactive "P")
  3648.   (let ((current (gnus-summary-article-number)))
  3649.     (setq gnus-show-threads
  3650.       (if (null arg) (not gnus-show-threads)
  3651.         (> (prefix-numeric-value arg) 0)))
  3652.     (gnus-summary-prepare)
  3653.     (gnus-summary-goto-subject current)
  3654.     ))
  3655.  
  3656. (defun gnus-summary-show-all-threads ()
  3657.   "Show all thread subtrees."
  3658.   (interactive)
  3659.   (if gnus-show-threads
  3660.       (save-excursion
  3661.     (let ((buffer-read-only nil))
  3662.       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
  3663.       ))))
  3664.  
  3665. (defun gnus-summary-show-thread ()
  3666.   "Show thread subtrees."
  3667.   (interactive)
  3668.   (if gnus-show-threads
  3669.       (save-excursion
  3670.     (let ((buffer-read-only nil))
  3671.       (subst-char-in-region (progn
  3672.                   (beginning-of-line) (point))
  3673.                 (progn
  3674.                   (end-of-line) (point))
  3675.                 ?\^M ?\n t)
  3676.       ))))
  3677.  
  3678. (defun gnus-summary-hide-all-threads ()
  3679.   "Hide all thread subtrees."
  3680.   (interactive)
  3681.   (if gnus-show-threads
  3682.       (save-excursion
  3683.     ;; Adjust cursor point.
  3684.     (goto-char (point-min))
  3685.     (search-forward ":" nil t)
  3686.     (let ((level (current-column)))
  3687.       (gnus-summary-hide-thread)
  3688.       (while (gnus-summary-search-forward)
  3689.         (and (>= level (current-column))
  3690.          (gnus-summary-hide-thread)))
  3691.       ))))
  3692.  
  3693. (defun gnus-summary-hide-thread ()
  3694.   "Hide thread subtrees."
  3695.   (interactive)
  3696.   (if gnus-show-threads
  3697.       (save-excursion
  3698.     ;; Adjust cursor point.
  3699.     (beginning-of-line)
  3700.     (search-forward ":" nil t)
  3701.     (let ((buffer-read-only nil)
  3702.           (init (point))
  3703.           (last (point))
  3704.           (level (current-column)))
  3705.       (while (and (gnus-summary-search-forward)
  3706.               (< level (current-column)))
  3707.         ;; Interested in lower levels.
  3708.         (if (< level (current-column))
  3709.         (progn
  3710.           (setq last (point))
  3711.           ))
  3712.         )
  3713.       (subst-char-in-region init last ?\n ?\^M t)
  3714.       ))))
  3715.  
  3716. (defun gnus-summary-next-thread (n)
  3717.   "Go to the same level next thread.
  3718. Argument N specifies the number of threads."
  3719.   (interactive "p")
  3720.   ;; Adjust cursor point.
  3721.   (beginning-of-line)
  3722.   (search-forward ":" nil t)
  3723.   (let ((init (point))
  3724.     (last (point))
  3725.     (level (current-column)))
  3726.     (while (and (> n 0)
  3727.         (gnus-summary-search-forward)
  3728.         (<= level (current-column)))
  3729.       ;; We have to skip lower levels.
  3730.       (if (= level (current-column))
  3731.       (progn
  3732.         (setq last (point))
  3733.         (setq n (1- n))
  3734.         ))
  3735.       )
  3736.     ;; Return non-nil if successfully move to the next.
  3737.     (prog1 (not (= init last))
  3738.       (goto-char last))
  3739.     ))
  3740.  
  3741. (defun gnus-summary-prev-thread (n)
  3742.   "Go to the same level previous thread.
  3743. Argument N specifies the number of threads."
  3744.   (interactive "p")
  3745.   ;; Adjust cursor point.
  3746.   (beginning-of-line)
  3747.   (search-forward ":" nil t)
  3748.   (let ((init (point))
  3749.     (last (point))
  3750.     (level (current-column)))
  3751.     (while (and (> n 0)
  3752.         (gnus-summary-search-backward)
  3753.         (<= level (current-column)))
  3754.       ;; We have to skip lower levels.
  3755.       (if (= level (current-column))
  3756.       (progn
  3757.         (setq last (point))
  3758.         (setq n (1- n))
  3759.         ))
  3760.       )
  3761.     ;; Return non-nil if successfully move to the previous.
  3762.     (prog1 (not (= init last))
  3763.       (goto-char last))
  3764.     ))
  3765.  
  3766. (defun gnus-summary-down-thread (d)
  3767.   "Go downward current thread.
  3768. Argument D specifies the depth goes down."
  3769.   (interactive "p")
  3770.   ;; Adjust cursor point.
  3771.   (beginning-of-line)
  3772.   (search-forward ":" nil t)
  3773.   (let ((last (point))
  3774.     (level (current-column)))
  3775.     (while (and (> d 0)
  3776.         (gnus-summary-search-forward)
  3777.         (<= level (current-column))) ;<= can be <.  Which do you like?
  3778.       ;; We have to skip the same levels.
  3779.       (if (< level (current-column))
  3780.       (progn
  3781.         (setq last (point))
  3782.         (setq level (current-column))
  3783.         (setq d (1- d))
  3784.         ))
  3785.       )
  3786.     (goto-char last)
  3787.     ))
  3788.  
  3789. (defun gnus-summary-up-thread (d)
  3790.   "Go upward current thread.
  3791. Argument D specifies the depth goes up."
  3792.   (interactive "p")
  3793.   ;; Adjust cursor point.
  3794.   (beginning-of-line)
  3795.   (search-forward ":" nil t)
  3796.   (let ((last (point))
  3797.     (level (current-column)))
  3798.     (while (and (> d 0)
  3799.         (gnus-summary-search-backward))
  3800.       ;; We have to skip the same levels.
  3801.       (if (> level (current-column))
  3802.       (progn
  3803.         (setq last (point))
  3804.         (setq level (current-column))
  3805.         (setq d (1- d))
  3806.         ))
  3807.       )
  3808.     (goto-char last)
  3809.     ))
  3810.  
  3811. (defun gnus-summary-kill-thread (unmark)
  3812.   "Mark articles under current thread as read.
  3813. If argument UNMARK is positive, remove any kinds of marks.
  3814. If argument UNMARK is negative, mark articles as unread instead."
  3815.   (interactive "P")
  3816.   (if unmark
  3817.       (setq unmark (prefix-numeric-value unmark)))
  3818.   ;; Adjust cursor point.
  3819.   (beginning-of-line)
  3820.   (search-forward ":" nil t)
  3821.   (save-excursion
  3822.     (let ((level (current-column)))
  3823.       ;; Mark current article.
  3824.       (cond ((null unmark)
  3825.          (gnus-summary-mark-as-read nil "K"))
  3826.         ((> unmark 0)
  3827.          (gnus-summary-mark-as-unread nil t))
  3828.         (t
  3829.          (gnus-summary-mark-as-unread))
  3830.         )
  3831.       ;; Mark following articles.
  3832.       (while (and (gnus-summary-search-forward)
  3833.           (< level (current-column)))
  3834.     (cond ((null unmark)
  3835.            (gnus-summary-mark-as-read nil "K"))
  3836.           ((> unmark 0)
  3837.            (gnus-summary-mark-as-unread nil t))
  3838.           (t
  3839.            (gnus-summary-mark-as-unread))
  3840.           ))
  3841.       ))
  3842.   ;; Hide killed subtrees.
  3843.   (and (null unmark)
  3844.        gnus-thread-hide-killed
  3845.        (gnus-summary-hide-thread))
  3846.   ;; If marked as read, go to next unread subject.
  3847.   (if (null unmark)
  3848.       ;; Go to next unread subject.
  3849.       (gnus-summary-next-subject 1 t))
  3850.   )
  3851.  
  3852. (defun gnus-summary-toggle-truncation (arg)
  3853.   "Toggle truncation of summary lines.
  3854. With arg, turn line truncation on iff arg is positive."
  3855.   (interactive "P")
  3856.   (setq truncate-lines
  3857.     (if (null arg) (not truncate-lines)
  3858.       (> (prefix-numeric-value arg) 0)))
  3859.   (redraw-display))
  3860.  
  3861. (defun gnus-summary-sort-by-number (reverse)
  3862.   "Sort Summary buffer by article number.
  3863. Argument REVERSE means reverse order."
  3864.   (interactive "P")
  3865.   (gnus-summary-keysort-summary
  3866.    (function <)
  3867.    (function
  3868.     (lambda (a)
  3869.       (nntp-header-number a)))
  3870.    reverse
  3871.    ))
  3872.  
  3873. (defun gnus-summary-sort-by-author (reverse)
  3874.   "Sort Summary buffer by author name alphabetically.
  3875. If case-fold-search is non-nil, case of letters is ignored.
  3876. Argument REVERSE means reverse order."
  3877.   (interactive "P")
  3878.   (gnus-summary-keysort-summary
  3879.    (function string-lessp)
  3880.    (function
  3881.     (lambda (a)
  3882.       (if case-fold-search
  3883.       (downcase (nntp-header-from a))
  3884.     (nntp-header-from a))))
  3885.    reverse
  3886.    ))
  3887.  
  3888. (defun gnus-summary-sort-by-subject (reverse)
  3889.   "Sort Summary buffer by subject alphabetically. `Re:'s are ignored.
  3890. If case-fold-search is non-nil, case of letters is ignored.
  3891. Argument REVERSE means reverse order."
  3892.   (interactive "P")
  3893.   (gnus-summary-keysort-summary
  3894.    (function string-lessp)
  3895.    (function
  3896.     (lambda (a)
  3897.       (if case-fold-search
  3898.       (downcase (gnus-simplify-subject (nntp-header-subject a) 're-only))
  3899.     (gnus-simplify-subject (nntp-header-subject a) 're-only))))
  3900.    reverse
  3901.    ))
  3902.  
  3903. (defun gnus-summary-sort-by-date (reverse)
  3904.   "Sort Summary buffer by date.
  3905. Argument REVERSE means reverse order."
  3906.   (interactive "P")
  3907.   (gnus-summary-keysort-summary
  3908.    (function string-lessp)
  3909.    (function
  3910.     (lambda (a)
  3911.       (gnus-sortable-date (nntp-header-date a))))
  3912.    reverse
  3913.    ))
  3914.  
  3915. (defun gnus-summary-keysort-summary (predicate key &optional reverse)
  3916.   "Sort Summary buffer by PREDICATE using a value passed by KEY.
  3917. Optional argument REVERSE means reverse order."
  3918.   (let ((current (gnus-summary-article-number)))
  3919.     (gnus-keysort-headers predicate key reverse)
  3920.     (gnus-summary-prepare)
  3921.     (gnus-summary-goto-subject current)
  3922.     ))
  3923.  
  3924. (defun gnus-summary-sort-summary (predicate &optional reverse)
  3925.   "Sort Summary buffer by PREDICATE.
  3926. Optional argument REVERSE means reverse order."
  3927.   (let ((current (gnus-summary-article-number)))
  3928.     (gnus-sort-headers predicate reverse)
  3929.     (gnus-summary-prepare)
  3930.     (gnus-summary-goto-subject current)
  3931.     ))
  3932.  
  3933. (defun gnus-summary-reselect-current-group (show-all)
  3934.   "Once exit and then reselect the current newsgroup.
  3935. Prefix argument SHOW-ALL means to select all articles."
  3936.   (interactive "P")
  3937.   (let ((current-subject (gnus-summary-article-number)))
  3938.     (gnus-summary-exit t)
  3939.     ;; We have to adjust the point of Group mode buffer because the
  3940.     ;; current point was moved to the next unread newsgroup by
  3941.     ;; exiting.
  3942.     (gnus-summary-jump-to-group gnus-newsgroup-name)
  3943.     (gnus-group-read-group show-all t)
  3944.     (gnus-summary-goto-subject current-subject)
  3945.     ))
  3946.  
  3947. (defun gnus-summary-caesar-message (rotnum)
  3948.   "Caesar rotates all letters of current message by 13/47 places.
  3949. With prefix arg, specifies the number of places to rotate each letter forward.
  3950. Caesar rotates Japanese letters by 47 places in any case."
  3951.   (interactive "P")
  3952.   (gnus-summary-select-article)
  3953.   (gnus-overload-functions)
  3954.   (gnus-eval-in-buffer-window gnus-article-buffer
  3955.     (save-restriction
  3956.       (widen)
  3957.       ;; We don't want to jump to the beginning of the message.
  3958.       ;; `save-excursion' does not do its job.
  3959.       (move-to-window-line 0)
  3960.       (let ((last (point)))
  3961.     (news-caesar-buffer-body rotnum)
  3962.     (goto-char last)
  3963.     (recenter 0)
  3964.     ))
  3965.     ))
  3966.  
  3967. (defun gnus-summary-rmail-digest ()
  3968.   "Run RMAIL on current digest article.
  3969. gnus-select-digest-hook will be called with no arguments, if that
  3970. value is non-nil. It is possible to modify the article so that Rmail
  3971. can work with it.
  3972. gnus-rmail-digest-hook will be called with no arguments, if that value
  3973. is non-nil. The hook is intended to customize Rmail mode."
  3974.   (interactive)
  3975.   (gnus-summary-select-article)
  3976.   (require 'rmail)
  3977.   (let ((artbuf gnus-article-buffer)
  3978.     (digbuf (get-buffer-create gnus-digest-buffer))
  3979.     (mail-header-separator ""))
  3980.     (set-buffer digbuf)
  3981.     (buffer-disable-undo (current-buffer))
  3982.     (setq buffer-read-only nil)
  3983.     (erase-buffer)
  3984.     (insert-buffer-substring artbuf)
  3985.     (run-hooks 'gnus-select-digest-hook)
  3986.     (gnus-convert-article-to-rmail)
  3987.     (goto-char (point-min))
  3988.     ;; Rmail initializations.
  3989.     (rmail-insert-rmail-file-header)
  3990.     (rmail-mode)
  3991.     (rmail-set-message-counters)
  3992.     (rmail-show-message)
  3993.     (condition-case ()
  3994.     (progn
  3995.       (undigestify-rmail-message)
  3996.       (rmail-expunge)        ;Delete original message.
  3997.       ;; File name is meaningless but `save-buffer' requires it.
  3998.       (setq buffer-file-name "GNUS Digest")
  3999.       (setq mode-line-buffer-identification
  4000.         (concat "Digest: "
  4001.             (nntp-header-subject gnus-current-headers)))
  4002.       ;; There is no need to write this buffer to a file.
  4003.       (make-local-variable 'write-file-hooks)
  4004.       (setq write-file-hooks
  4005.         (list (function
  4006.                (lambda ()
  4007.              (set-buffer-modified-p nil)
  4008.              (message "(No changes need to be saved)")
  4009.              'no-need-to-write-this-buffer))))
  4010.       ;; Default file name saving digest messages.
  4011.       (setq rmail-last-rmail-file
  4012.         (funcall gnus-rmail-save-name
  4013.              gnus-newsgroup-name
  4014.              gnus-current-headers
  4015.              gnus-newsgroup-last-rmail
  4016.              ))
  4017.       (setq rmail-last-file
  4018.         (funcall gnus-mail-save-name
  4019.              gnus-newsgroup-name
  4020.              gnus-current-headers
  4021.              gnus-newsgroup-last-mail
  4022.              ))
  4023.       ;; Prevent generating new buffer named ***<N> each time.
  4024.       (setq rmail-summary-buffer
  4025.         (get-buffer-create gnus-digest-summary-buffer))
  4026.       (run-hooks 'gnus-rmail-digest-hook)
  4027.       ;; Take all windows safely.
  4028.       (gnus-configure-windows '(1 0 0))
  4029.       (gnus-pop-to-buffer gnus-group-buffer)
  4030.       ;; Use Summary Article windows for Digest summary and
  4031.       ;; Digest buffers.
  4032.       (if gnus-digest-show-summary
  4033.           (let ((gnus-summary-buffer gnus-digest-summary-buffer)
  4034.             (gnus-article-buffer gnus-digest-buffer))
  4035.         (gnus-configure-windows 'article)
  4036.         (gnus-pop-to-buffer gnus-digest-buffer)
  4037.         (rmail-summary)
  4038.         (gnus-pop-to-buffer gnus-digest-summary-buffer)
  4039.         (message (substitute-command-keys
  4040.               "Type \\[rmail-summary-quit] to return to GNUS")))
  4041.         (let ((gnus-summary-buffer gnus-digest-buffer))
  4042.           (gnus-configure-windows 'summary)
  4043.           (gnus-pop-to-buffer gnus-digest-buffer)
  4044.           (message (substitute-command-keys
  4045.             "Type \\[rmail-quit] to return to GNUS")))
  4046.         )
  4047.       ;; Move the buffers to the end of buffer list.
  4048.       (bury-buffer gnus-article-buffer)
  4049.       (bury-buffer gnus-group-buffer)
  4050.       (bury-buffer gnus-digest-summary-buffer)
  4051.       (bury-buffer gnus-digest-buffer))
  4052.       (error (set-buffer-modified-p nil)
  4053.          (kill-buffer digbuf)
  4054.          ;; This command should not signal an error because the
  4055.          ;; command is called from hooks.
  4056.          (ding) (message "Article is not a digest")))
  4057.     ))
  4058.  
  4059. (defun gnus-summary-save-article ()
  4060.   "Save this article using default saver function.
  4061. The variable `gnus-default-article-saver' specifies the saver function."
  4062.   (interactive)
  4063.   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
  4064.   (if gnus-default-article-saver
  4065.       (call-interactively gnus-default-article-saver)
  4066.     (error "No default saver is defined.")))
  4067.  
  4068. (defun gnus-summary-save-in-rmail (&optional filename)
  4069.   "Append this article to Rmail file.
  4070. Optional argument FILENAME specifies file name.
  4071. Directory to save to is default to `gnus-article-save-directory' which
  4072. is initialized from the SAVEDIR environment variable."
  4073.   (interactive)
  4074.   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
  4075.   (gnus-eval-in-buffer-window gnus-article-buffer
  4076.     (save-excursion
  4077.       (save-restriction
  4078.     (widen)
  4079.     (let ((default-name
  4080.         (funcall gnus-rmail-save-name
  4081.              gnus-newsgroup-name
  4082.              gnus-current-headers
  4083.              gnus-newsgroup-last-rmail
  4084.              )))
  4085.       (or filename
  4086.           (setq filename
  4087.             (read-file-name
  4088.              (concat "Save article in Rmail file: (default "
  4089.                  (file-name-nondirectory default-name)
  4090.                  ") ")
  4091.              (file-name-directory default-name)
  4092.              default-name)))
  4093.       (gnus-make-directory (file-name-directory filename))
  4094.       (gnus-output-to-rmail filename)
  4095.       ;; Remember the directory name to save articles.
  4096.       (setq gnus-newsgroup-last-rmail filename)
  4097.       )))
  4098.     ))
  4099.  
  4100. (defun gnus-summary-save-in-mail (&optional filename)
  4101.   "Append this article to Unix mail file.
  4102. Optional argument FILENAME specifies file name.
  4103. Directory to save to is default to `gnus-article-save-directory' which
  4104. is initialized from the SAVEDIR environment variable."
  4105.   (interactive)
  4106.   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
  4107.   (gnus-eval-in-buffer-window gnus-article-buffer
  4108.     (save-excursion
  4109.       (save-restriction
  4110.     (widen)
  4111.     (let ((default-name
  4112.         (funcall gnus-mail-save-name
  4113.              gnus-newsgroup-name
  4114.              gnus-current-headers
  4115.              gnus-newsgroup-last-mail
  4116.              )))
  4117.       (or filename
  4118.           (setq filename
  4119.             (read-file-name
  4120.              (concat "Save article in Unix mail file: (default "
  4121.                  (file-name-nondirectory default-name)
  4122.                  ") ")
  4123.              (file-name-directory default-name)
  4124.              default-name)))
  4125.       (setq filename
  4126.         (expand-file-name filename
  4127.                   (and default-name
  4128.                        (file-name-directory default-name))))
  4129.       (gnus-make-directory (file-name-directory filename))
  4130.       (if (and (file-readable-p filename) (rmail-file-p filename))
  4131.           (gnus-output-to-rmail filename)
  4132.         (rmail-output filename 1 t t))
  4133.       ;; Remember the directory name to save articles.
  4134.       (setq gnus-newsgroup-last-mail filename)
  4135.       )))
  4136.     ))
  4137.  
  4138. (defun gnus-summary-save-in-file (&optional filename)
  4139.   "Append this article to file.
  4140. Optional argument FILENAME specifies file name.
  4141. Directory to save to is default to `gnus-article-save-directory' which
  4142. is initialized from the SAVEDIR environment variable."
  4143.   (interactive)
  4144.   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
  4145.   (gnus-eval-in-buffer-window gnus-article-buffer
  4146.     (save-excursion
  4147.       (save-restriction
  4148.     (widen)
  4149.     (let ((default-name
  4150.         (funcall gnus-file-save-name
  4151.              gnus-newsgroup-name
  4152.              gnus-current-headers
  4153.              gnus-newsgroup-last-file
  4154.              )))
  4155.       (or filename
  4156.           (setq filename
  4157.             (read-file-name
  4158.              (concat "Save article in file: (default "
  4159.                  (file-name-nondirectory default-name)
  4160.                  ") ")
  4161.              (file-name-directory default-name)
  4162.              default-name)))
  4163.       (gnus-make-directory (file-name-directory filename))
  4164.       (gnus-output-to-file filename)
  4165.       ;; Remember the directory name to save articles.
  4166.       (setq gnus-newsgroup-last-file filename)
  4167.       )))
  4168.     ))
  4169.  
  4170. (defun gnus-summary-save-in-folder (&optional folder)
  4171.   "Save this article to MH folder (using `rcvstore' in MH library).
  4172. Optional argument FOLDER specifies folder name."
  4173.   (interactive)
  4174.   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
  4175.   (gnus-eval-in-buffer-window gnus-article-buffer
  4176.     (save-restriction
  4177.       (widen)
  4178.       ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
  4179.       (mh-find-path)
  4180.       (let ((folder
  4181.          (or folder
  4182.          (mh-prompt-for-folder "Save article in"
  4183.                        (funcall gnus-folder-save-name
  4184.                         gnus-newsgroup-name
  4185.                         gnus-current-headers
  4186.                         gnus-newsgroup-last-folder
  4187.                         )
  4188.                        t
  4189.                        )))
  4190.         (errbuf (get-buffer-create " *GNUS rcvstore*")))
  4191.     (unwind-protect
  4192.         (call-process-region (point-min) (point-max)
  4193.                  (expand-file-name "rcvstore" mh-lib)
  4194.                  nil errbuf nil folder)
  4195.       (set-buffer errbuf)
  4196.       (if (zerop (buffer-size))
  4197.           (message "Article saved in folder: %s" folder)
  4198.         (message "%s" (buffer-string)))
  4199.       (kill-buffer errbuf)
  4200.       (setq gnus-newsgroup-last-folder folder))
  4201.     ))
  4202.     ))
  4203.  
  4204. (defun gnus-summary-pipe-output ()
  4205.   "Pipe this article to subprocess."
  4206.   (interactive)
  4207.   ;; Ignore `gnus-save-all-headers' since this is not save command.
  4208.   ;;(gnus-summary-select-article)
  4209.   ;; Huuum.  Is this right?
  4210.   (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
  4211.   (gnus-eval-in-buffer-window gnus-article-buffer
  4212.     (save-restriction
  4213.       (widen)
  4214.       (let ((command (read-string "Shell command on article: "
  4215.                   gnus-last-shell-command)))
  4216.     (if (string-equal command "")
  4217.         (setq command gnus-last-shell-command))
  4218.     (shell-command-on-region (point-min) (point-max) command nil)
  4219.     (setq gnus-last-shell-command command)
  4220.     ))
  4221.     ))
  4222.  
  4223. (defun gnus-summary-catchup (all &optional quietly)
  4224.   "Mark all articles not marked as unread in this newsgroup as read.
  4225. If prefix argument ALL is non-nil, all articles are marked as read."
  4226.   (interactive "P")
  4227.   (if (or quietly
  4228.       (y-or-n-p
  4229.        (if all
  4230.            "Do you really want to mark everything as read? "
  4231.          "Delete all articles not marked as unread? ")))
  4232.       (let ((unmarked
  4233.          (gnus-set-difference gnus-newsgroup-unreads
  4234.                   (if (not all) gnus-newsgroup-marked))))
  4235.         (message "")            ;Erase "Yes or No" question.
  4236.     ;; Hidden thread subtrees must be searched for ,too.
  4237.     (gnus-summary-show-all-threads)
  4238.     (while unmarked
  4239.           (gnus-summary-mark-as-read (car unmarked) "C")
  4240.       (setq unmarked (cdr unmarked))
  4241.       ))
  4242.     ))
  4243.  
  4244. (defun gnus-summary-catchup-all (&optional quietly)
  4245.   "Mark all articles in this newsgroup as read."
  4246.   (interactive)
  4247.   (gnus-summary-catchup t quietly))
  4248.  
  4249. (defun gnus-summary-catchup-and-exit (all &optional quietly)
  4250.   "Mark all articles not marked as unread in this newsgroup as read, then exit.
  4251. If prefix argument ALL is non-nil, all articles are marked as read."
  4252.   (interactive "P")
  4253.   (if (or quietly
  4254.       (y-or-n-p
  4255.        (if all
  4256.            "Do you really want to mark everything as read? "
  4257.          "Delete all articles not marked as unread? ")))
  4258.       (let ((unmarked
  4259.              (gnus-set-difference gnus-newsgroup-unreads
  4260.                                   (if (not all) gnus-newsgroup-marked))))
  4261.         (message "")            ;Erase "Yes or No" question.
  4262.     (while unmarked
  4263.           (gnus-mark-article-as-read (car unmarked))
  4264.       (setq unmarked (cdr unmarked)))
  4265.     ;; Select next newsgroup or exit.
  4266.     (cond ((eq gnus-auto-select-next 'quietly)
  4267.            ;; Select next newsgroup quietly.
  4268.            (gnus-summary-next-group nil))
  4269.           (t
  4270.            (gnus-summary-exit)))
  4271.     )))
  4272.  
  4273. (defun gnus-summary-catchup-all-and-exit (&optional quietly)
  4274.   "Mark all articles in this newsgroup as read, and then exit."
  4275.   (interactive)
  4276.   (gnus-summary-catchup-and-exit t quietly))
  4277.  
  4278. (defun gnus-summary-edit-global-kill ()
  4279.   "Edit a global KILL file."
  4280.   (interactive)
  4281.   (setq gnus-current-kill-article (gnus-summary-article-number))
  4282.   (gnus-kill-file-edit-file nil)    ;Nil stands for global KILL file.
  4283.   (message
  4284.    (substitute-command-keys
  4285.     "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
  4286.  
  4287. (defun gnus-summary-edit-local-kill ()
  4288.   "Edit a local KILL file applied to the current newsgroup."
  4289.   (interactive)
  4290.   (setq gnus-current-kill-article (gnus-summary-article-number))
  4291.   (gnus-kill-file-edit-file gnus-newsgroup-name)
  4292.   (message
  4293.    (substitute-command-keys
  4294.     "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
  4295.  
  4296. ;; XEmacs change
  4297. (defvar gnus-digest-mode nil)
  4298.  
  4299. (defun gnus-summary-exit (&optional temporary)
  4300.   "Exit reading current newsgroup, and then return to group selection mode.
  4301. gnus-exit-group-hook is called with no arguments if that value is non-nil."
  4302.   (interactive)
  4303.   ;; XEmacs change
  4304.   (if gnus-digest-mode
  4305.       (gnus-unselect-digest-article)
  4306.     ;; else
  4307.   (let ((updated nil)
  4308.     (gnus-newsgroup-headers gnus-newsgroup-headers)
  4309.     (gnus-newsgroup-unreads gnus-newsgroup-unreads)
  4310.     (gnus-newsgroup-unselected gnus-newsgroup-unselected)
  4311.     (gnus-newsgroup-marked gnus-newsgroup-marked))
  4312.     ;; Important internal variables are saved, so we can reenter
  4313.     ;; Summary buffer even if hook changes them.
  4314.     (run-hooks 'gnus-exit-group-hook)
  4315.     (gnus-update-unread-articles gnus-newsgroup-name
  4316.                  (append gnus-newsgroup-unselected
  4317.                      gnus-newsgroup-unreads)
  4318.                  gnus-newsgroup-marked)
  4319.     ;; T means ignore unsubscribed newsgroups.
  4320.     (if gnus-use-cross-reference
  4321.     (setq updated
  4322.           (gnus-mark-as-read-by-xref gnus-newsgroup-name
  4323.                      gnus-newsgroup-headers
  4324.                      gnus-newsgroup-unreads
  4325.                      (eq gnus-use-cross-reference t)
  4326.                      )))
  4327.     ;; Do not switch windows but change the buffer to work.
  4328.     (set-buffer gnus-group-buffer)
  4329.     ;; Update cross referenced group info.
  4330.     (while updated
  4331.       (gnus-group-update-group (car updated) t) ;Ignore invisible group.
  4332.       (setq updated (cdr updated)))
  4333.     (gnus-group-update-group gnus-newsgroup-name))
  4334.   ;; Make sure where I was, and go to next newsgroup.
  4335.   (gnus-group-jump-to-group gnus-newsgroup-name)
  4336.   (gnus-group-next-unread-group 1)
  4337.   (if temporary
  4338.       ;; If exiting temporary, caller should adjust Group mode
  4339.       ;; buffer point by itself.
  4340.       nil                ;Nothing to do.
  4341.     ;; Return to Group mode buffer.
  4342.     (if (get-buffer gnus-summary-buffer)
  4343.     (bury-buffer gnus-summary-buffer))
  4344.     (if (get-buffer gnus-article-buffer)
  4345.     (bury-buffer gnus-article-buffer))
  4346.     (gnus-configure-windows 'newsgroups)
  4347.     (gnus-pop-to-buffer gnus-group-buffer))))
  4348.  
  4349. (defun gnus-summary-quit ()
  4350.   "Quit reading current newsgroup without updating read article info."
  4351.   (interactive)
  4352.   (if (y-or-n-p "Do you really wanna quit reading this group? ")
  4353.       (progn
  4354.     (message "")            ;Erase "Yes or No" question.
  4355.     ;; Return to Group selection mode.
  4356.     (if (get-buffer gnus-summary-buffer)
  4357.         (bury-buffer gnus-summary-buffer))
  4358.     (if (get-buffer gnus-article-buffer)
  4359.         (bury-buffer gnus-article-buffer))
  4360.     (gnus-configure-windows 'newsgroups)
  4361.     (gnus-pop-to-buffer gnus-group-buffer)
  4362.     (gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
  4363.     (gnus-group-next-group 1)    ;(gnus-group-next-unread-group 1)
  4364.     )))
  4365.  
  4366. (defun gnus-summary-describe-briefly ()
  4367.   "Describe Summary mode commands briefly."
  4368.   (interactive)
  4369.   (message
  4370.    (concat
  4371.     (substitute-command-keys "\\[gnus-summary-next-page]:Select  ")
  4372.     (substitute-command-keys "\\[gnus-summary-next-unread-article]:Forward  ")
  4373.     (substitute-command-keys "\\[gnus-summary-prev-unread-article]:Backward  ")
  4374.     (substitute-command-keys "\\[gnus-summary-exit]:Exit  ")
  4375.     (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
  4376.     (substitute-command-keys "\\[gnus-summary-describe-briefly]:This help")
  4377.     )))
  4378.  
  4379.  
  4380. ;;;
  4381. ;;; GNUS Article Mode
  4382. ;;;
  4383.  
  4384. (if gnus-article-mode-map
  4385.     nil
  4386.   (setq gnus-article-mode-map (make-keymap))
  4387.   (suppress-keymap gnus-article-mode-map)
  4388.   (define-key gnus-article-mode-map " " 'gnus-article-next-page)
  4389.   (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
  4390.   (define-key gnus-article-mode-map "r" 'gnus-article-refer-article)
  4391.   (define-key gnus-article-mode-map "o" 'gnus-article-pop-article)
  4392.   (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
  4393.   (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
  4394.   (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
  4395.   (define-key gnus-article-mode-map "\C-c\C-i" 'gnus-info-find-node))
  4396.  
  4397. (defun gnus-article-mode ()
  4398.   "Major mode for browsing through an article.
  4399. All normal editing commands are turned off.
  4400. Instead, these commands are available:
  4401. \\{gnus-article-mode-map}
  4402.  
  4403. Various hooks for customization:
  4404.  gnus-article-mode-hook
  4405.     Entry to this mode calls the value with no arguments, if that
  4406.     value is non-nil.
  4407.  
  4408.  gnus-article-prepare-hook
  4409.     Called with no arguments after an article is prepared for reading,
  4410.     if that value is non-nil."
  4411.   (interactive)
  4412.   (kill-all-local-variables)
  4413.   ;; Gee.  Why don't you upgrade?
  4414.   (cond ((boundp 'mode-line-modified)
  4415.      (setq mode-line-modified "--- "))
  4416.     ((listp (default-value 'mode-line-format))
  4417.      (setq mode-line-format
  4418.            (cons "--- " (cdr (default-value 'mode-line-format))))))
  4419.   ;; To disable display-time facility.
  4420.   ;;(make-local-variable 'global-mode-string)
  4421.   ;;(setq global-mode-string nil)
  4422.   (setq major-mode 'gnus-article-mode)
  4423.   (setq mode-name "Article")
  4424.   (make-local-variable 'minor-mode-alist)
  4425.   (or (assq 'gnus-show-mime minor-mode-alist)
  4426.       (setq minor-mode-alist
  4427.         (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
  4428.   (gnus-article-set-mode-line)
  4429.   (use-local-map gnus-article-mode-map)
  4430.   (make-local-variable 'page-delimiter)
  4431.   (setq page-delimiter gnus-page-delimiter)
  4432.   (make-local-variable 'mail-header-separator)
  4433.   (setq mail-header-separator "")    ;For caesar function.
  4434.   (buffer-disable-undo (current-buffer))
  4435.   (setq buffer-read-only t)        ;Disable modification
  4436.   (run-hooks 'gnus-article-mode-hook))
  4437.  
  4438. (defun gnus-article-setup-buffer ()
  4439.   "Initialize Article mode buffer."
  4440.   (or (get-buffer gnus-article-buffer)
  4441.       (save-excursion
  4442.     (set-buffer (get-buffer-create gnus-article-buffer))
  4443.     (gnus-article-mode))
  4444.       ))
  4445.  
  4446.  
  4447.  
  4448. ;;; We hold these truths to be self-evident: that there should be a summary
  4449. ;;; line for every article ever displayed in the *Article* buffer; and that
  4450. ;;; all commands in the *Summary* buffer should apply to the indicated summary
  4451. ;;; line rather than whatever happens to be displayed in the *Article* buffer.
  4452. ;;;
  4453. ;;; Therefore, when selecting other articles by message id or article number,
  4454. ;;; we must cons up new summary lines.
  4455. ;;;
  4456. ;;; However, GNUS internally insists on using article-numbers all over the
  4457. ;;; place instead of message-ids, and when retrieving an article by ID, one
  4458. ;;; can't generally determine what the message *number* was (in fact, it may
  4459. ;;; not belong to the current group, and thus may not have a number at all in
  4460. ;;; this context).  So we generate new message-numbers which won't conflict
  4461. ;;; because they are negative.
  4462. ;;;
  4463. ;;; In addition, we have to impose a mapping between these generated message-
  4464. ;;; numbers and something that NNTP (or whatever the transport layer is) 
  4465. ;;; understands, i.e., message IDs.  That's what gnus-message-id-map does, 
  4466. ;;; and why gnus-retrieve-headers is no longer a direct call to 
  4467. ;;; nntp-retrieve-headers.
  4468. ;;;                -- jwz and ckd
  4469.  
  4470. (defvar gnus-dummy-article-number 0) ; n.b. this counts *downward*
  4471. (defvar gnus-message-id-map nil)
  4472.  
  4473. (defun gnus-ensure-article-summary (article)
  4474.  "Make sure the given article has a line in the *Summary* buffer, and go there.
  4475. ARTICLE may be an article number (in the current group) or a message id."
  4476.   (let ((header nil)
  4477.     (already-there nil))
  4478.     (cond
  4479.      ((stringp article)            ;a message-id ref
  4480.       (let ((existing-header (gnus-find-header-by-message-id article)))
  4481.     (if existing-header
  4482.         (setq already-there (nntp-header-number existing-header))
  4483.       ;; This header may not have a number; generate one (YUCK!!)
  4484.       (setq header (car (gnus-retrieve-headers-by-id (list article))))
  4485.         (if (and header (= 0 (nntp-header-number header)))
  4486.           (let ((n (setq gnus-dummy-article-number
  4487.                  (1- gnus-dummy-article-number))))
  4488.         (setq gnus-message-id-map
  4489.               (cons (cons n article) gnus-message-id-map))
  4490.         (nntp-set-header-number header n))))))
  4491.  
  4492.      ((integerp article)        ;an article number
  4493.       (let ((cb (current-buffer)))
  4494.     (set-buffer gnus-summary-buffer)
  4495.     (if (gnus-summary-goto-subject article)
  4496.         (setq already-there article)
  4497.       (setq header (car (gnus-retrieve-headers (list article)))))
  4498.     (set-buffer cb)))
  4499.      (t                    ;neither message-id or article?
  4500.       (error "Bad argument to gnus-ensure-article-summary, %s" article)))
  4501.  
  4502.     (or already-there
  4503.     header
  4504.     (error "No such article as %s (may be canceled/expired)" article))
  4505.  
  4506.     (if already-there
  4507.     (gnus-summary-goto-subject already-there)
  4508.       ;; put the new header just before the one we're reading now
  4509.       (let ((cb (current-buffer)))
  4510.     (set-buffer gnus-summary-buffer)
  4511.     (beginning-of-line)
  4512.     (save-restriction
  4513.       (narrow-to-region (point) (point))
  4514.       (let ((buffer-read-only nil))
  4515.         (gnus-summary-prepare-threads (list header) 0)))
  4516.     (gnus-clear-hashtables-for-newsgroup-headers)
  4517.     (or (gnus-summary-goto-subject (nntp-header-number header))
  4518.         (error "couldn't find header we just added?"))
  4519.     (set-buffer cb))
  4520.       ;; enter this header in the list of current articles
  4521.       (setq gnus-newsgroup-headers
  4522.         (nconc gnus-newsgroup-headers (list header))))))
  4523.  
  4524. (defun gnus-find-header-by-message-id (message-id)
  4525.   "Given a message id, returns the corresponding nntp header structure.
  4526. If that message id is not present in the current newsgroup, returns nil."
  4527.   (let ((rest gnus-newsgroup-headers)
  4528.     (result nil))
  4529.     (while rest
  4530.       (if (equal (downcase message-id)
  4531.          (downcase (nntp-header-id (car rest))))
  4532.       (setq result (car rest)
  4533.         rest nil))
  4534.       (setq rest (cdr rest)))
  4535.     result))
  4536.  
  4537.  
  4538. (defun gnus-retrieve-headers (sequence)
  4539.   ;; Note, gnus-message-id-map is only consulted when retrieving one
  4540.   ;; article at a time.  This is probably a bug.
  4541.   (let ((shadow (and gnus-message-id-map
  4542.              (null (cdr sequence))
  4543.              (assq (car sequence) gnus-message-id-map))))
  4544.     (if (null shadow)
  4545.     ;; check for sequence really being a lone message-id
  4546.     (if (stringp (car sequence))
  4547.         (gnus-retrieve-headers-by-id sequence)
  4548.       (gnus-retrieve-headers-1 sequence))
  4549.       ;; if we went through the map, we know it's a message-id
  4550.       (let ((headers (gnus-retrieve-headers-by-id (list (cdr shadow)))))
  4551.     (if headers (nntp-set-header-number (car headers) (car shadow)))
  4552.     headers))))
  4553.  
  4554. (defun gnus-request-article (article)
  4555.   (let ((shadow (and gnus-message-id-map
  4556.              (assq article gnus-message-id-map))))
  4557.     (gnus-request-article-1 (or (cdr shadow) article))))
  4558.  
  4559.  
  4560. (defun gnus-article-prepare (article &optional all-headers)
  4561.   "Prepare ARTICLE in Article mode buffer.
  4562. ARTICLE can be either a article number or Message-ID.
  4563. If optional argument ALL-HEADERS is non-nil, all headers are inserted."
  4564.   ;; Make sure a connection to NNTP server is alive.
  4565.   (if (not (gnus-server-opened))
  4566.       (progn
  4567.     (gnus-start-news-server)
  4568.     (gnus-request-group gnus-newsgroup-name)))
  4569.   (save-excursion
  4570.     (set-buffer gnus-article-buffer)
  4571.     (let ((buffer-read-only nil))
  4572.       (erase-buffer)
  4573.  
  4574.       ;; logic fixed and indentation simplified by jwz.
  4575.  
  4576.       ;; mhspool does not work with Message-ID.  So, let's translate
  4577.       ;; it into an article number as possible as can.  This may help
  4578.       ;; nnspool too.
  4579.       ;; Note: this conversion must be done here since if the article
  4580.       ;; is specified by number or message-id has a different meaning
  4581.       ;; in the following.
  4582.       (or gnus-digest-mode
  4583.       (numberp article)
  4584.       (let* ((header (and (stringp article)
  4585.                   (gnus-get-header-by-id article))))
  4586.         (setq article (or (and header (nntp-header-number header))
  4587.                   article))))
  4588.  
  4589.       (cond (gnus-digest-mode
  4590.          (or (gnus-request-digest-article article)
  4591.          (error "couldn't select digest article %s??" article)))
  4592.         ((not (gnus-request-article article))
  4593.          (error "No such article as %s (may be canceled/expired)"
  4594.             article)))
  4595.  
  4596.       ;; Prepare article buffer
  4597.       (insert-buffer-substring nntp-server-buffer)
  4598.       ;; gnus-have-all-headers must be either T or NIL.
  4599.       (setq gnus-have-all-headers
  4600.         (not (not (or all-headers gnus-show-all-headers))))
  4601.       (if (and (numberp article)
  4602.            (not (eq article gnus-current-article)))
  4603.       ;; Seems me that a new article has been selected.
  4604.       (progn
  4605.         ;; gnus-current-article must be an article number.
  4606.         (setq gnus-last-article gnus-current-article)
  4607.         (setq gnus-current-article article)
  4608.         (setq gnus-current-headers
  4609.           (gnus-get-header-by-number gnus-current-article))
  4610.         (run-hooks 'gnus-mark-article-hook)
  4611.         ))
  4612.       ;; Clear article history only when the article is
  4613.       ;; retrieved by the article number.
  4614.       (if (numberp article)
  4615.       (setq gnus-current-history nil))
  4616.  
  4617.       ;; Added by jwz: always set these when selecting a new article, so that
  4618.       ;; starting a post, selecting a new article, and then going back to the
  4619.       ;; *post-news* buffer and doing -yank-original will insert attributions
  4620.       ;; corresponding to the text yanked, instead of inserting the text of
  4621.       ;; the current article and the username/message-id of the old article!
  4622.       (setq news-reply-yank-from (mail-fetch-field "from")
  4623.         news-reply-yank-message-id (mail-fetch-field "message-id"))
  4624.  
  4625.       ;; Hooks for modifying contents of the article.  This hook
  4626.       ;; must be called before being narrowed.
  4627.       (run-hooks 'gnus-article-prepare-hook)
  4628.       ;; Decode MIME message.
  4629.       (if (and gnus-show-mime
  4630.            (gnus-fetch-field "Mime-Version"))
  4631.       (funcall gnus-show-mime-method))
  4632.       ;; Delete unnecessary headers.
  4633.       (or gnus-have-all-headers
  4634.       (gnus-article-delete-headers))
  4635.       ;; Do page break.
  4636.       (goto-char (point-min))
  4637.       (if gnus-break-pages
  4638.       (gnus-narrow-to-page))
  4639.       ;; Next function must be called after setting
  4640.       ;;  `gnus-current-article' variable and narrowed to page.
  4641.       (gnus-article-set-mode-line)
  4642.       )))
  4643.  
  4644. (defun gnus-article-show-all-headers ()
  4645.   "Show all article headers in Article mode buffer."
  4646.   (or gnus-have-all-headers
  4647.       ;; changed by jwz: when showing all headers, configure windows and
  4648.       ;; run hooks, so that highlighting gets done correctly.
  4649.       ;;      (gnus-article-prepare gnus-current-article t)
  4650.       (save-excursion (gnus-summary-display-article gnus-current-article t))
  4651.       ))
  4652.  
  4653. ;;(defun gnus-article-set-mode-line ()
  4654. ;;  "Set Article mode line string."
  4655. ;;  (setq mode-line-buffer-identification
  4656. ;;    (list 17
  4657. ;;          (format "GNUS: %s {%d-%d} %d"
  4658. ;;              gnus-newsgroup-name
  4659. ;;              gnus-newsgroup-begin
  4660. ;;              gnus-newsgroup-end
  4661. ;;              gnus-current-article
  4662. ;;                    )))
  4663. ;;  (set-buffer-modified-p t))
  4664.  
  4665. ;;(defun gnus-article-set-mode-line ()
  4666. ;;  "Set Article mode line string."
  4667. ;;  (let ((unmarked
  4668. ;;     (- (length gnus-newsgroup-unreads)
  4669. ;;        (length (gnus-intersection
  4670. ;;             gnus-newsgroup-unreads gnus-newsgroup-marked))))
  4671. ;;    (unselected
  4672. ;;     (- (length gnus-newsgroup-unselected)
  4673. ;;        (length (gnus-intersection
  4674. ;;             gnus-newsgroup-unselected gnus-newsgroup-marked)))))
  4675. ;;    (setq mode-line-buffer-identification
  4676. ;;      (list 17
  4677. ;;        (format "GNUS: %s{%d} %s"
  4678. ;;            gnus-newsgroup-name
  4679. ;;            gnus-current-article
  4680. ;;            ;; This is proposed by tale@pawl.rpi.edu.
  4681. ;;            (cond ((and (zerop unmarked)
  4682. ;;                    (zerop unselected))
  4683. ;;                   "      ")
  4684. ;;                  ((zerop unselected)
  4685. ;;                   (format "%d more" unmarked))
  4686. ;;                  (t
  4687. ;;                   (format "%d(+%d) more" unmarked unselected)))
  4688. ;;            ))))
  4689. ;;  (set-buffer-modified-p t))
  4690.  
  4691. ;; New implementation in gnus 3.14.3
  4692.  
  4693. (defun gnus-article-set-mode-line ()
  4694.   "Set Article mode line string.
  4695. If you don't like it, define your own gnus-article-set-mode-line."
  4696.   (let ((maxlen 15)            ;Maximum subject length
  4697.     (subject
  4698.      (if gnus-current-headers
  4699.          (nntp-header-subject gnus-current-headers) "")))
  4700.     ;; The value must be a string to escape %-constructs because of subject.
  4701.     (setq mode-line-buffer-identification
  4702.       (format "GNUS: %s%s %s%s%s"
  4703.           gnus-newsgroup-name
  4704.           (if gnus-current-article
  4705.               (format "/%d" gnus-current-article) "")
  4706.           (substring subject 0 (min (length subject) maxlen))
  4707.           (if (> (length subject) maxlen) "..." "")
  4708.           (make-string (max 0 (- 17 (length subject))) ? )
  4709.           )))
  4710.   (set-buffer-modified-p t))
  4711.  
  4712. (defun gnus-article-delete-headers ()
  4713.   "Delete unnecessary headers."
  4714.   (save-excursion
  4715.     (save-restriction
  4716.       (goto-char (point-min))
  4717.       (narrow-to-region (point-min)
  4718.             (progn (search-forward "\n\n" nil 'move) (point)))
  4719.       (goto-char (point-min))
  4720.       (and (stringp gnus-ignored-headers)
  4721.        (while (re-search-forward gnus-ignored-headers nil t)
  4722.          (beginning-of-line)
  4723.          (delete-region (point)
  4724.                 (progn (re-search-forward "\n[^ \t]")
  4725.                    (forward-char -1)
  4726.                    (point)))))
  4727.       )))
  4728.  
  4729. ;; Working on article's buffer
  4730.  
  4731. (defun gnus-article-next-page (lines)
  4732.   "Show next page of current article.
  4733. If end of article, return non-nil. Otherwise return nil.
  4734. Argument LINES specifies lines to be scrolled up."
  4735.   (interactive "P")
  4736.   (move-to-window-line -1)
  4737.   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
  4738.   (if (save-excursion
  4739.     (end-of-line)
  4740.     (and (pos-visible-in-window-p)    ;Not continuation line.
  4741.          (eobp)))
  4742.       ;; Nothing in this page.
  4743.       (if (or (not gnus-break-pages)
  4744.           (save-excursion
  4745.         (save-restriction
  4746.           (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
  4747.       t                ;Nothing more.
  4748.     (gnus-narrow-to-page 1)        ;Go to next page.
  4749.     nil
  4750.     )
  4751.     ;; More in this page.
  4752.     (condition-case ()
  4753.     (scroll-up lines)
  4754.       (end-of-buffer
  4755.        ;; Long lines may cause an end-of-buffer error.
  4756.        (goto-char (point-max))))
  4757.     nil
  4758.     ))
  4759.  
  4760. (defun gnus-article-prev-page (lines)
  4761.   "Show previous page of current article.
  4762. Argument LINES specifies lines to be scrolled down."
  4763.   (interactive "P")
  4764.   (move-to-window-line 0)
  4765.   (if (and gnus-break-pages
  4766.        (bobp)
  4767.        (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
  4768.       (progn
  4769.     (gnus-narrow-to-page -1) ;Go to previous page.
  4770.     (goto-char (point-max))
  4771.     (recenter -1))
  4772.     (scroll-down lines)))
  4773.  
  4774. (defun gnus-article-next-digest (nth)
  4775.   "Move to head of NTH next digested message.
  4776. Set mark at end of digested message."
  4777.   ;; Stop page breaking in digest mode.
  4778.   (widen)
  4779.   (end-of-line)
  4780.   ;; Skip NTH - 1 digest.
  4781.   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
  4782.   ;; Digest separator is customizable.
  4783.   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
  4784.   (while (and (> nth 1)
  4785.           (re-search-forward gnus-digest-separator nil 'move))
  4786.     (setq nth (1- nth)))
  4787.   (if (re-search-forward gnus-digest-separator nil t)
  4788.       (let ((begin (point)))
  4789.     ;; Search for end of this message.
  4790.     (end-of-line)
  4791.     (if (re-search-forward gnus-digest-separator nil t)
  4792.         (progn
  4793.           (search-backward "\n\n")    ;This may be incorrect.
  4794.           (forward-line 1))
  4795.       (goto-char (point-max)))
  4796.     (push-mark)            ;Set mark at end of digested message.
  4797.     (goto-char begin)
  4798.     (beginning-of-line)
  4799.     ;; Show From: and Subject: fields.
  4800.     (recenter 1))
  4801.     (message "End of message")
  4802.     ))
  4803.  
  4804. (defun gnus-article-prev-digest (nth)
  4805.   "Move to head of NTH previous digested message."
  4806.   ;; Stop page breaking in digest mode.
  4807.   (widen)
  4808.   (beginning-of-line)
  4809.   ;; Skip NTH - 1 digest.
  4810.   ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
  4811.   ;; Digest separator is customizable.
  4812.   ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
  4813.   (while (and (> nth 1)
  4814.           (re-search-backward gnus-digest-separator nil 'move))
  4815.     (setq nth (1- nth)))
  4816.   (if (re-search-backward gnus-digest-separator nil t)
  4817.       (let ((begin (point)))
  4818.     ;; Search for end of this message.
  4819.     (end-of-line)
  4820.     (if (re-search-forward gnus-digest-separator nil t)
  4821.         (progn
  4822.           (search-backward "\n\n")    ;This may be incorrect.
  4823.           (forward-line 1))
  4824.       (goto-char (point-max)))
  4825.     (push-mark)            ;Set mark at end of digested message.
  4826.     (goto-char begin)
  4827.     ;; Show From: and Subject: fields.
  4828.     (recenter 1))
  4829.     (goto-char (point-min))
  4830.     (message "Top of message")
  4831.     ))
  4832.  
  4833. (defun gnus-article-refer-article ()
  4834.   "Read article specified by message-id around point."
  4835.   (interactive)
  4836.   (save-window-excursion
  4837.     (save-excursion
  4838.       (re-search-forward ">" nil t)    ;Move point to end of "<....>".
  4839.       (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
  4840.       (let ((message-id
  4841.          (buffer-substring (match-beginning 1) (match-end 1))))
  4842.         (set-buffer gnus-summary-buffer)
  4843.         (gnus-summary-refer-article message-id))
  4844.     (error "No references around point"))
  4845.       )))
  4846.  
  4847. (defun gnus-article-pop-article ()
  4848.   "Pop up article history."
  4849.   (interactive)
  4850.   (save-window-excursion
  4851.     (set-buffer gnus-summary-buffer)
  4852.     (gnus-summary-refer-article nil)))
  4853.  
  4854. (defun gnus-article-show-summary ()
  4855.   "Reconfigure windows to show Summary buffer."
  4856.   (interactive)
  4857.   (gnus-configure-windows 'article)
  4858.   (gnus-pop-to-buffer gnus-summary-buffer)
  4859.   (gnus-summary-goto-subject gnus-current-article))
  4860.  
  4861. (defun gnus-article-describe-briefly ()
  4862.   "Describe Article mode commands briefly."
  4863.   (interactive)
  4864.   (message
  4865.    (concat
  4866.     (substitute-command-keys "\\[gnus-article-next-page]:Next page  ")
  4867.     (substitute-command-keys "\\[gnus-article-prev-page]:Prev page  ")
  4868.     (substitute-command-keys "\\[gnus-article-show-summary]:Show Summary  ")
  4869.     (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
  4870.     (substitute-command-keys "\\[gnus-article-describe-briefly]:This help")
  4871.     )))
  4872.  
  4873.  
  4874. ;;;
  4875. ;;; GNUS KILL-File Mode
  4876. ;;;
  4877.  
  4878. (if gnus-kill-file-mode-map
  4879.     nil
  4880.   (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
  4881.   (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject)
  4882.   (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author)
  4883.   (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer)
  4884.   (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
  4885.   (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit)
  4886.   (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node))
  4887.  
  4888. (defun gnus-kill-file-mode ()
  4889.   "Major mode for editing KILL file.
  4890.  
  4891. In addition to Emacs-Lisp Mode, the following commands are available:
  4892.  
  4893. \\[gnus-kill-file-kill-by-subject]    Insert KILL command for current subject.
  4894. \\[gnus-kill-file-kill-by-author]    Insert KILL command for current author.
  4895. \\[gnus-kill-file-apply-buffer]    Apply current buffer to selected newsgroup.
  4896. \\[gnus-kill-file-apply-last-sexp]    Apply sexp before point to selected newsgroup.
  4897. \\[gnus-kill-file-exit]    Save file and exit editing KILL file.
  4898. \\[gnus-info-find-node]    Read Info about KILL file.
  4899.  
  4900.   A KILL file contains lisp expressions to be applied to a selected
  4901. newsgroup. The purpose is to mark articles as read on the basis of
  4902. some set of regexps. A global KILL file is applied to every newsgroup,
  4903. and a local KILL file is applied to a specified newsgroup. Since a
  4904. global KILL file is applied to every newsgroup, for better performance
  4905. use a local one.
  4906.  
  4907.   A KILL file can contain any kind of Emacs lisp expressions expected
  4908. to be evaluated in the Summary buffer. Writing lisp programs for this
  4909. purpose is not so easy because the internal working of GNUS must be
  4910. well-known. For this reason, GNUS provides a general function which
  4911. does this easily for non-Lisp programmers.
  4912.  
  4913.   The `gnus-kill' function executes commands available in Summary Mode
  4914. by their key sequences. `gnus-kill' should be called with FIELD,
  4915. REGEXP and optional COMMAND and ALL. FIELD is a string representing
  4916. the header field or an empty string. If FIELD is an empty string, the
  4917. entire article body is searched for. REGEXP is a string which is
  4918. compared with FIELD value. COMMAND is a string representing a valid
  4919. key sequence in Summary Mode or Lisp expression. COMMAND is default to
  4920. '(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is
  4921. executed in the Summary buffer.  If the second optional argument ALL
  4922. is non-nil, the COMMAND is applied to articles which are already
  4923. marked as read or unread.  Articles which are marked are skipped over
  4924. by default.
  4925.  
  4926.   For example, if you want to mark articles of which subjects contain
  4927. the string `AI' as read, a possible KILL file may look like:
  4928.  
  4929.     (gnus-kill \"Subject\" \"AI\")
  4930.  
  4931.   If you want to mark articles with `D' instead of `X', you can use
  4932. the following expression:
  4933.  
  4934.     (gnus-kill \"Subject\" \"AI\" \"d\")
  4935.  
  4936. In this example it is assumed that the command
  4937. `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
  4938.  
  4939.   It is possible to delete unnecessary headers which are marked with
  4940. `X' in a KILL file as follows:
  4941.  
  4942.     (gnus-expunge \"X\")
  4943.  
  4944.   If the Summary buffer is empty after applying KILL files, GNUS will
  4945. exit the selected newsgroup normally.  If headers which are marked
  4946. with `D' are deleted in a KILL file, it is impossible to read articles
  4947. which are marked as read in the previous GNUS sessions.  Marks other
  4948. than `D' should be used for articles which should really be deleted.
  4949.  
  4950. Entry to this mode calls emacs-lisp-mode-hook and
  4951. gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
  4952.   (interactive)
  4953.   (kill-all-local-variables)
  4954.   (use-local-map gnus-kill-file-mode-map)
  4955.   (set-syntax-table emacs-lisp-mode-syntax-table)
  4956.   (setq major-mode 'gnus-kill-file-mode)
  4957.   (setq mode-name "KILL-File")
  4958.   (lisp-mode-variables nil)
  4959.   (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
  4960.  
  4961. (defun gnus-kill-file-edit-file (newsgroup)
  4962.   "Begin editing a KILL file of NEWSGROUP.
  4963. If NEWSGROUP is nil, the global KILL file is selected."
  4964.   (interactive "sNewsgroup: ")
  4965.   (let ((file (gnus-newsgroup-kill-file newsgroup)))
  4966.     (gnus-make-directory (file-name-directory file))
  4967.     ;; Save current window configuration if this is first invocation.
  4968.     (or (and (get-file-buffer file)
  4969.          (get-buffer-window (get-file-buffer file)))
  4970.     (setq gnus-winconf-kill-file (current-window-configuration)))
  4971.     ;; Hack windows.
  4972.     (let ((buffer (find-file-noselect file)))
  4973.       (cond ((get-buffer-window buffer)
  4974.          (gnus-pop-to-buffer buffer))
  4975.         ((eq major-mode 'gnus-group-mode)
  4976.          (gnus-configure-windows '(1 0 0)) ;Take all windows.
  4977.          (gnus-pop-to-buffer gnus-group-buffer)
  4978.          (let ((gnus-summary-buffer buffer))
  4979.            (gnus-configure-windows '(1 1 0)) ;Split into two.
  4980.            (gnus-pop-to-buffer buffer)))
  4981.         ((eq major-mode 'gnus-summary-mode)
  4982.          (gnus-configure-windows 'article)
  4983.          (gnus-pop-to-buffer gnus-article-buffer)
  4984.          (bury-buffer gnus-article-buffer)
  4985.          (switch-to-buffer buffer))
  4986.         (t                ;No good rules.
  4987.          (find-file-other-window file))
  4988.         ))
  4989.     (gnus-kill-file-mode)
  4990.     ))
  4991.  
  4992. (defun gnus-kill-file-kill-by-subject ()
  4993.   "Insert KILL command for current subject."
  4994.   (interactive)
  4995.   (insert
  4996.    (format "(gnus-kill \"Subject\" %s)\n"
  4997.        (prin1-to-string
  4998.         (if gnus-current-kill-article
  4999.         (regexp-quote
  5000.          (nntp-header-subject
  5001.           ;; No need to speed up this command.
  5002.           ;;(gnus-get-header-by-number gnus-current-kill-article)
  5003.           (gnus-find-header-by-number gnus-newsgroup-headers
  5004.                           gnus-current-kill-article)))
  5005.           "")))))
  5006.  
  5007. (defun gnus-kill-file-kill-by-author ()
  5008.   "Insert KILL command for current author."
  5009.   (interactive)
  5010.   (insert
  5011.    (format "(gnus-kill \"From\" %s)\n"
  5012.        (prin1-to-string
  5013.         (if gnus-current-kill-article
  5014.         (regexp-quote
  5015.          (nntp-header-from
  5016.           ;; No need to speed up this command.
  5017.           ;;(gnus-get-header-by-number gnus-current-kill-article)
  5018.           (gnus-find-header-by-number gnus-newsgroup-headers
  5019.                           gnus-current-kill-article)))
  5020.           "")))))
  5021.  
  5022. (defun gnus-kill-file-apply-buffer ()
  5023.   "Apply current buffer to current newsgroup."
  5024.   (interactive)
  5025.   (if (and gnus-current-kill-article
  5026.        (get-buffer gnus-summary-buffer))
  5027.       ;; Assume newsgroup is selected.
  5028.       (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
  5029.     (save-excursion
  5030.       (save-window-excursion
  5031.         (gnus-pop-to-buffer gnus-summary-buffer)
  5032.         (eval (car (read-from-string string))))))
  5033.     (ding) (message "No newsgroup is selected.")))
  5034.  
  5035. (defun gnus-kill-file-apply-last-sexp ()
  5036.   "Apply sexp before point in current buffer to current newsgroup."
  5037.   (interactive)
  5038.   (if (and gnus-current-kill-article
  5039.        (get-buffer gnus-summary-buffer))
  5040.       ;; Assume newsgroup is selected.
  5041.       (let ((string
  5042.          (buffer-substring
  5043.           (save-excursion (forward-sexp -1) (point)) (point))))
  5044.     (save-excursion
  5045.       (save-window-excursion
  5046.         (gnus-pop-to-buffer gnus-summary-buffer)
  5047.         (eval (car (read-from-string string))))))
  5048.     (ding) (message "No newsgroup is selected.")))
  5049.  
  5050. (defun gnus-kill-file-exit ()
  5051.   "Save a KILL file, then return to the previous buffer."
  5052.   (interactive)
  5053.   (save-buffer)
  5054.   (let ((killbuf (current-buffer)))
  5055.     ;; We don't want to return to Article buffer.
  5056.     (and (get-buffer gnus-article-buffer)
  5057.      (bury-buffer (get-buffer gnus-article-buffer)))
  5058.     ;; Delete the KILL file windows.
  5059.     (delete-windows-on killbuf)
  5060.     ;; Restore last window configuration if available.
  5061.     (and gnus-winconf-kill-file
  5062.      (set-window-configuration gnus-winconf-kill-file))
  5063.     (setq gnus-winconf-kill-file nil)
  5064.     ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
  5065.     (kill-buffer killbuf)))
  5066.  
  5067.  
  5068. ;;;
  5069. ;;; Utility functions
  5070. ;;;
  5071.  
  5072. ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
  5073.  
  5074. (defvar command-line-args-left) ; loser
  5075.  
  5076. ;;;###autoload
  5077. (defun gnus-batch-kill ()
  5078.   "Run batched KILL.
  5079. Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
  5080.   (if (not noninteractive)
  5081.       (error "gnus-batch-kill is to be used only with -batch"))
  5082.   (let* ((group nil)
  5083.      (subscribed nil)
  5084.      (newsrc nil)
  5085.      (yes-and-no
  5086.       (gnus-parse-n-options
  5087.        (apply (function concat)
  5088.           (mapcar (function (lambda (g) (concat g " ")))
  5089.               command-line-args-left))))
  5090.      (yes (car yes-and-no))
  5091.      (no  (cdr yes-and-no))
  5092.      ;; Disable verbose message.
  5093.      (gnus-novice-user nil)
  5094.      (gnus-large-newsgroup nil)
  5095.      (nntp-large-newsgroup nil))
  5096.     ;; Eat all arguments.
  5097.     (setq command-line-args-left nil)
  5098.     ;; Startup GNUS.
  5099.     (gnus)
  5100.     ;; Apply kills to specified newsgroups in command line arguments.
  5101.     (setq newsrc (copy-sequence gnus-newsrc-assoc))
  5102.     (while newsrc
  5103.       (setq group (car (car newsrc)))
  5104.       (setq subscribed (nth 1 (car newsrc)))
  5105.       (setq newsrc (cdr newsrc))
  5106.       (if (and subscribed
  5107.            (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
  5108.            (if yes
  5109.            (string-match yes group) t)
  5110.            (or (null no)
  5111.            (not (string-match no group))))
  5112.       (progn
  5113.         (gnus-summary-read-group group nil t)
  5114.         (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
  5115.         (gnus-summary-exit t))
  5116.         ))
  5117.       )
  5118.     ;; Finally, exit Emacs.
  5119.     (set-buffer gnus-group-buffer)
  5120.     (gnus-group-exit)
  5121.     ))
  5122.  
  5123. ;; For saving articles
  5124.  
  5125. (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
  5126.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  5127. If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
  5128. Otherwise, it is like ~/News/news/group/num."
  5129.   (let ((default
  5130.       (expand-file-name
  5131.        (concat (if gnus-use-long-file-name
  5132.                (gnus-capitalize-newsgroup newsgroup)
  5133.              (gnus-newsgroup-directory-form newsgroup))
  5134.            "/" (int-to-string (nntp-header-number headers)))
  5135.        (or gnus-article-save-directory "~/News"))))
  5136.     (if (and last-file
  5137.          (string-equal (file-name-directory default)
  5138.                (file-name-directory last-file))
  5139.          (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
  5140.     default
  5141.       (or last-file default))))
  5142.  
  5143. (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
  5144.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  5145. If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
  5146. Otherwise, it is like ~/News/news/group/num."
  5147.   (let ((default
  5148.       (expand-file-name
  5149.        (concat (if gnus-use-long-file-name
  5150.                newsgroup
  5151.              (gnus-newsgroup-directory-form newsgroup))
  5152.            "/" (int-to-string (nntp-header-number headers)))
  5153.        (or gnus-article-save-directory "~/News"))))
  5154.     (if (and last-file
  5155.          (string-equal (file-name-directory default)
  5156.                (file-name-directory last-file))
  5157.          (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
  5158.     default
  5159.       (or last-file default))))
  5160.  
  5161. (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
  5162.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  5163. If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
  5164. Otherwise, it is like ~/News/news/group/news."
  5165.   (or last-file
  5166.       (expand-file-name
  5167.        (if gnus-use-long-file-name
  5168.        (gnus-capitalize-newsgroup newsgroup)
  5169.      (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
  5170.        (or gnus-article-save-directory "~/News"))))
  5171.  
  5172. (defun gnus-plain-save-name (newsgroup headers &optional last-file)
  5173.   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
  5174. If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
  5175. Otherwise, it is like ~/News/news/group/news."
  5176.   (or last-file
  5177.       (expand-file-name
  5178.        (if gnus-use-long-file-name
  5179.        newsgroup
  5180.      (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
  5181.        (or gnus-article-save-directory "~/News"))))
  5182.  
  5183. (defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
  5184.   "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
  5185. If variable `gnus-use-long-file-name' is nil, it is +News.group.
  5186. Otherwise, it is like +news/group."
  5187.   (or last-folder
  5188.       (concat "+"
  5189.           (if gnus-use-long-file-name
  5190.           (gnus-capitalize-newsgroup newsgroup)
  5191.         (gnus-newsgroup-directory-form newsgroup)))))
  5192.  
  5193. (defun gnus-folder-save-name (newsgroup headers &optional last-folder)
  5194.   "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
  5195. If variable `gnus-use-long-file-name' is nil, it is +news.group.
  5196. Otherwise, it is like +news/group."
  5197.   (or last-folder
  5198.       (concat "+"
  5199.           (if gnus-use-long-file-name
  5200.           newsgroup
  5201.         (gnus-newsgroup-directory-form newsgroup)))))
  5202.  
  5203. ;; For KILL files
  5204.  
  5205. ;; added by jwz for better messages
  5206. (defvar gnus-killcount 0 "internal to gnus-apply-kill-file")
  5207.  
  5208. ;; XEmacs addition for better error checking
  5209. (defun gnus-load-kill-file (file)
  5210.   (if debug-on-error
  5211.       ;; don't trap the error if the user wants a debugger
  5212.       (load file t nil t)
  5213.     (condition-case c
  5214.     (load file t nil t)
  5215.       (error
  5216.        (beep)
  5217.        (message "Error in kill file %s" file)
  5218.        (cond ((fboundp 'display-error) ; XEmacs
  5219.           (princ ": ")
  5220.           (display-error c nil)))
  5221.        (sit-for 2)))))
  5222.  
  5223. ;; modified by jwz to say how much was killed
  5224. (defun gnus-apply-kill-file ()
  5225.   "Apply KILL file to the current newsgroup."
  5226.   (let ((gnus-killcount 0) ; dynamic - incremented by gnus-kill
  5227.     (nmessages (save-excursion (set-buffer gnus-summary-buffer)
  5228.                    (count-lines (point-min) (point-max)))))
  5229.     ;; Apply the global KILL file.
  5230.     (gnus-load-kill-file (gnus-newsgroup-kill-file nil))
  5231.     ;; And then apply the local KILL file.
  5232.     (gnus-load-kill-file (gnus-newsgroup-kill-file gnus-newsgroup-name))
  5233.     (if (= gnus-killcount 0)
  5234.         nil
  5235.       (message "Killed %d article%s (%d%%)."
  5236.            gnus-killcount (if (= gnus-killcount 1) "" "s")
  5237.            (/ (* 100 gnus-killcount) nmessages)))))
  5238.  
  5239. (defun gnus-Newsgroup-kill-file (newsgroup)
  5240.   "Return the name of a KILL file of NEWSGROUP.
  5241. If NEWSGROUP is nil, return the global KILL file instead."
  5242.   (cond ((or (null newsgroup)
  5243.          (string-equal newsgroup ""))
  5244.      ;; The global KILL file is placed at top of the directory.
  5245.      (expand-file-name gnus-kill-file-name
  5246.                (or gnus-article-save-directory "~/News")))
  5247.     (gnus-use-long-file-name
  5248.      ;; Append ".KILL" to capitalized newsgroup name.
  5249.      (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
  5250.                    "." gnus-kill-file-name)
  5251.                (or gnus-article-save-directory "~/News")))
  5252.     (t
  5253.      ;; Place "KILL" under the hierarchical directory.
  5254.      (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
  5255.                    "/" gnus-kill-file-name)
  5256.                (or gnus-article-save-directory "~/News")))
  5257.     ))
  5258.  
  5259. (defun gnus-newsgroup-kill-file (newsgroup)
  5260.   "Return the name of a KILL file of NEWSGROUP.
  5261. If NEWSGROUP is nil, return the global KILL file instead."
  5262.   (cond ((or (null newsgroup)
  5263.          (string-equal newsgroup ""))
  5264.      ;; The global KILL file is placed at top of the directory.
  5265.      (expand-file-name gnus-kill-file-name
  5266.                (or gnus-article-save-directory "~/News")))
  5267.     (gnus-use-long-file-name
  5268.      ;; Append ".KILL" to newsgroup name.
  5269.      (expand-file-name (concat newsgroup "." gnus-kill-file-name)
  5270.                (or gnus-article-save-directory "~/News")))
  5271.     (t
  5272.      ;; Place "KILL" under the hierarchical directory.
  5273.      (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
  5274.                    "/" gnus-kill-file-name)
  5275.                (or gnus-article-save-directory "~/News")))
  5276.     ))
  5277.  
  5278. ;; For subscribing new newsgroup
  5279.  
  5280. (defun gnus-subscribe-randomly (newsgroup)
  5281.   "Subscribe new NEWSGROUP and insert it at the beginning of newsgroups."
  5282.   (gnus-subscribe-newsgroup newsgroup
  5283.                 (car (car gnus-newsrc-assoc))))
  5284.  
  5285. (defun gnus-subscribe-alphabetically (newgroup)
  5286.   "Subscribe new NEWSGROUP and insert it in strict alphabetic order."
  5287.   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
  5288.   (let ((groups gnus-newsrc-assoc)
  5289.     (before nil))
  5290.     (while (and (not before) groups)
  5291.       (if (string< newgroup (car (car groups)))
  5292.       (setq before (car (car groups)))
  5293.     (setq groups (cdr groups))))
  5294.     (gnus-subscribe-newsgroup newgroup before)
  5295.     ))
  5296.  
  5297. (defun gnus-subscribe-hierarchically (newgroup)
  5298.   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
  5299.   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
  5300.   (save-excursion
  5301.     (set-buffer (find-file-noselect gnus-current-startup-file))
  5302.     (let ((groupkey newgroup)
  5303.       (before nil))
  5304.       (while (and (not before) groupkey)
  5305.     (goto-char (point-min))
  5306.     (let ((groupkey-re
  5307.            (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
  5308.       (while (and (re-search-forward groupkey-re nil t)
  5309.               (progn
  5310.             (setq before (buffer-substring
  5311.                       (match-beginning 1) (match-end 1)))
  5312.             (string< before newgroup)))
  5313.         ))
  5314.     ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
  5315.     (setq groupkey
  5316.           (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
  5317.           (substring groupkey (match-beginning 1) (match-end 1)))))
  5318.       (gnus-subscribe-newsgroup newgroup before)
  5319.       )))
  5320.  
  5321. (defun gnus-subscribe-interactively (newsgroup)
  5322.   "Subscribe new NEWSGROUP interactively.
  5323. It is inserted in hierarchical newsgroup order if subscribed.
  5324. Unless, it is killed."
  5325.   (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
  5326.       (gnus-subscribe-hierarchically newsgroup)
  5327.     ;; Save in kill-ring
  5328.     (gnus-subscribe-newsgroup newsgroup)
  5329.     (gnus-kill-newsgroup newsgroup)))
  5330.  
  5331.  
  5332. ;; XEmacs addition: being friendlier to new or infrequent users.
  5333. (defun gnus-subscribe-many (groups)
  5334.   "If lots of newsgroups have been added, this is used to add them.
  5335. It prompts the user for the action to take, instead of slowly subscribing
  5336. each group individually."
  5337.   (save-window-excursion
  5338.     (let ((sorted (sort (copy-sequence groups) 'string-lessp))
  5339.       (shortname (file-name-nondirectory gnus-current-startup-file))
  5340.       answer)
  5341.       (with-output-to-temp-buffer "*Help*"
  5342.     (set-buffer standard-output)
  5343.     (cond
  5344.      ((not (file-exists-p gnus-current-startup-file))
  5345.       (insert (format "\nThere are %d newsgroups, and you have no %s file."
  5346.               (length groups) shortname)))
  5347.      ((file-exists-p (concat gnus-current-startup-file ".el"))
  5348.       (insert (format
  5349.            "\n%d new newsgroups have been added since the last time you ran GNUS."
  5350.            (length groups))))
  5351.      (t
  5352.       (insert (format
  5353.            "\nThere are %d newsgroups which are not mentioned in %s."
  5354.            (length groups) shortname))))
  5355.     (insert (format "\n
  5356.    S    subscribe to them all (you can unsubscribe individually later)
  5357.    U    unsubscribe to them all, but keep them in %s
  5358.    K    unsubscribe to them all, and never mention them again
  5359.    I    ask whether to subscribe to each of them\n"
  5360.             shortname))
  5361.     (cond ((< (length sorted) 300)
  5362.            (insert "\nThe new newsgroups are:\n\n")
  5363.            ;; Call display-completion-list to get multi-column output.
  5364.            ;; (But then delete the "Possible completions" blurb...)
  5365.            (let ((completion-setup-hook nil))
  5366.          (display-completion-list sorted))
  5367.            (goto-char (point-min))
  5368.            (if (re-search-forward "^Possible completions.*\n" nil t)
  5369.            (delete-region (match-beginning 0) (match-end 0)))
  5370.            (goto-char (point-min))
  5371.            ))
  5372.     )
  5373.       (setq answer nil)
  5374.       (while (null answer)
  5375.     (message "Option (U, K, I, or S): ")
  5376.     (let ((cursor-in-echo-area t))
  5377.       (setq answer (upcase (condition-case nil (read-char) (error nil))))
  5378.       (if (memq answer '(?U ?K  ?I  ?S))
  5379.           nil
  5380.         (beep)
  5381.         (message "Please type U, K, I, or S.")
  5382.         (sit-for 2)
  5383.         (setq answer nil))))
  5384.       (let ((buffer-read-only nil))
  5385.     (erase-buffer)
  5386.     (cond
  5387.      ((= answer ?U)
  5388.       (gnus-insert-new-newsgroups sorted nil))
  5389.      ((= answer ?S)
  5390.       (gnus-insert-new-newsgroups sorted t))
  5391.      ((= answer ?K)
  5392.       (let ((rest sorted)
  5393.         (total (length sorted))
  5394.         (count 0))
  5395.         (while rest
  5396.           (if (string-match gnus-subscribe-default-groups (car rest))
  5397.           (gnus-insert-newsgroup (list (car rest) t))
  5398.         ;; this doesn't work this early:
  5399.         ;; (gnus-kill-newsgroup (car rest))
  5400.         (setq gnus-killed-assoc
  5401.               (cons (cons (car rest) nil) gnus-killed-assoc)))
  5402.           (gnus-lazy-message "Killing new newsgroups... %d%%"
  5403.                  (/ count total))
  5404.           (setq count (+ count 100))
  5405.           (setq rest (cdr rest)))
  5406.         ;; modify the .newsrc buffer so that these killed groups are sure
  5407.         ;; to be saved in .newsrc.el.
  5408.         (save-excursion
  5409.           (set-buffer (or (get-file-buffer gnus-current-startup-file)
  5410.                   (find-file-noselect gnus-current-startup-file)))
  5411.           (set-buffer-modified-p t))
  5412.         ))
  5413.      ((= answer ?I)
  5414.       (let ((rest sorted))
  5415.         (while rest
  5416.           (if (string-match gnus-subscribe-default-groups (car rest))
  5417.           (gnus-insert-newsgroup (list (car rest) t))
  5418.         (gnus-subscribe-interactively (car rest)))
  5419.           (setq rest (cdr rest)))
  5420.         ))
  5421.      (t (error "internal error"))))))
  5422.   (message nil))
  5423.  
  5424.  
  5425. (defun gnus-subscribe-newsgroup (newsgroup &optional next)
  5426.   "Subscribe new NEWSGROUP.
  5427. If optional argument NEXT is non-nil, it is inserted before NEXT."
  5428.   (gnus-insert-newsgroup (list newsgroup t) next)
  5429.   (message "Subscribe newsgroup: %s" newsgroup))
  5430.  
  5431. ;; For directories
  5432.  
  5433. (defun gnus-newsgroup-directory-form (newsgroup)
  5434.   "Make hierarchical directory name from NEWSGROUP name."
  5435.   (let ((newsgroup (substring newsgroup 0)) ;Copy string.
  5436.     (len (length newsgroup))
  5437.     (idx 0))
  5438.     ;; Replace all occurrences of `.' with `/'.
  5439.     (while (< idx len)
  5440.       (if (= (aref newsgroup idx) ?.)
  5441.       (aset newsgroup idx ?/))
  5442.       (setq idx (1+ idx)))
  5443.     newsgroup
  5444.     ))
  5445.  
  5446. (defun gnus-make-directory (directory)
  5447.   "Make DIRECTORY recursively."
  5448.   (let ((directory (expand-file-name directory default-directory)))
  5449.     (or (file-exists-p directory)
  5450.     (gnus-make-directory-1 "" directory))
  5451.     ))
  5452.  
  5453. (defun gnus-make-directory-1 (head tail)
  5454.   (cond ((string-match "^/\\([^/]+\\)" tail)
  5455.      ;; ange-ftp interferes with calling match-* after
  5456.      ;; calling file-name-as-directory.
  5457.      (let ((beg (match-beginning 1))
  5458.            (end (match-end 1)))
  5459.        (setq head (concat (file-name-as-directory head)
  5460.                   (substring tail beg end)))
  5461.        (or (file-exists-p head)
  5462.            (call-process "mkdir" nil nil nil head))
  5463.        (gnus-make-directory-1 head (substring tail end))))
  5464.     ((string-equal tail "") t)
  5465.     ))
  5466.  
  5467. (defun gnus-capitalize-newsgroup (newsgroup)
  5468.   "Capitalize NEWSGROUP name with treating '.' and '-' as part of words."
  5469.   ;; Suggested by "Jonathan I. Kamens" <jik@pit-manager.MIT.EDU>.
  5470.   (let ((current-syntax-table (copy-syntax-table (syntax-table))))
  5471.     (unwind-protect
  5472.     (progn
  5473.       (modify-syntax-entry ?- "w")
  5474.       (modify-syntax-entry ?. "w")
  5475.       (capitalize newsgroup))
  5476.       (set-syntax-table current-syntax-table))))
  5477.  
  5478. ;; XEmacs: modified this to strip leading and trailing whitespace, 
  5479. ;; and "Part 01" and similar cruft.
  5480. (defun gnus-simplify-subject (subject &optional re-only)
  5481.   "Remove `Re:' and words in parentheses.
  5482. If optional argument RE-ONLY is non-nil, strip `Re:' only."
  5483.   (let ((case-fold-search t))        ;Ignore case.
  5484.     ;; Remove `Re:' and `Re^N:'.
  5485.     (if (string-match "\\`[ \t]*\\(re\\(\\^[0-9]+\\)?:[ \t]+\\)+" subject)
  5486.     (setq subject (substring subject (match-end 0))))
  5487.     ;; Remove words in parentheses from end.
  5488.     (or re-only
  5489.     (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
  5490.       (setq subject (substring subject 0 (match-beginning 0)))))
  5491.     ;; XEmacs: remove trailing "Part 3 of 5", "Part 03/05", etc.
  5492.     (and (string-match
  5493.        "[, \t]*part[ \t]*[0-9]+[ \t]*\\(of\\|/\\)[ \t]*[0-9]*\\'"
  5494.        subject)
  5495.      (setq subject (substring subject 0 (match-beginning 0))))
  5496.     ;; XEmacs: remove leading archive-version spec like in comp.sources.x
  5497.     ;; (that is, like "v11i087")
  5498.     (and (string-match "\\`[ \t]*v[0-9]+i[0-9]+:[ \t]*" subject)
  5499.      (setq subject (substring subject (match-end 0))))
  5500.     ;; XEmacs: remove leading and trailing whitespace
  5501.     (and (string-match "\\`[ \t]+" subject)
  5502.      (setq subject (substring subject (match-end 0))))
  5503.     (and (string-match "[ \t]+\\'" subject)
  5504.      (setq subject (substring subject 0 (match-beginning 0))))
  5505.     ;; Return subject string.
  5506.     subject
  5507.     ))
  5508.  
  5509. ;; XEmacs change: create less temporary garbage, and use 
  5510. ;; mail-extract-address-components instead of mail-strip-quoted-names 
  5511. ;; if it is defined (as a function or autoload.)
  5512. (defun gnus-optional-lines-and-from (header)
  5513.   "Return a string like `NNN:AUTHOR' from HEADER."
  5514.   ;; the size of the string is duplicated in 3 places (as 17 and as 13)
  5515.   ;; but that's so that we can create one less string by letting `format'
  5516.   ;; put in padding for us instead of doing it by hand.
  5517.   (let* ((string (format "%3d:%-13s"
  5518.              ;; Lines of the article.
  5519.              ;; Suggested by dana@bellcore.com.
  5520.              (nntp-header-lines header)
  5521.              ;; Its author.
  5522.              (if (fboundp 'mail-extract-address-components)
  5523.                  (car (cdr (mail-extract-address-components
  5524.                     (nntp-header-from header))))
  5525.                (mail-strip-quoted-names (nntp-header-from header)))
  5526.              )))
  5527.     (if (> (length string) 17)
  5528.     (substring string 0 17)
  5529.       string)))
  5530.  
  5531. (defun gnus-optional-lines (header)
  5532.   "Return a string like `NNN' from HEADER."
  5533.   (format "%4d" (nntp-header-lines header)))
  5534.  
  5535. ;; Basic ideas by flee@cs.psu.edu (Felix Lee)
  5536.  
  5537. (defun gnus-keysort-headers (predicate key &optional reverse)
  5538.   "Sort current headers by PREDICATE using a value passed by KEY safely.
  5539. *Safely* means C-g quitting is disabled during sort.
  5540. Optional argument REVERSE means reverse order."
  5541.   (let ((inhibit-quit t))
  5542.     (setq gnus-newsgroup-headers
  5543.       (if reverse
  5544.           (nreverse
  5545.            (gnus-keysort (nreverse gnus-newsgroup-headers) predicate key))
  5546.         (gnus-keysort gnus-newsgroup-headers predicate key)))
  5547.     ;; Make sure we don't have to call
  5548.     ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
  5549.     ;; tables for the variable gnus-newsgroup-headers since no new
  5550.     ;; entry is added to nor deleted from the variable.
  5551.     ))
  5552.  
  5553. (defun gnus-keysort (list predicate key)
  5554.   "Sort LIST by PREDICATE using a value passed by KEY."
  5555.   (mapcar (function cdr)
  5556.       (sort (mapcar (function (lambda (a) (cons (funcall key a) a))) list)
  5557.         (function (lambda (a b)
  5558.                 (funcall predicate (car a) (car b)))))))
  5559.  
  5560. (defun gnus-sort-headers (predicate &optional reverse)
  5561.   "Sort current headers by PREDICATE safely.
  5562. *Safely* means C-g quitting is disabled during sort.
  5563. Optional argument REVERSE means reverse order."
  5564.   (let ((inhibit-quit t))
  5565.     (setq gnus-newsgroup-headers
  5566.       (if reverse
  5567.           (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
  5568.         (sort gnus-newsgroup-headers predicate)))
  5569.     ;; Make sure we don't have to call
  5570.     ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
  5571.     ;; tables for the variable gnus-newsgroup-headers since no new
  5572.     ;; entry is added to nor deleted from the variable.
  5573.     ))
  5574.  
  5575. (defun gnus-string-lessp (a b)
  5576.   "Return T if first arg string is less than second in lexicographic order.
  5577. If case-fold-search is non-nil, case of letters is ignored."
  5578.   (if case-fold-search
  5579.       (string-lessp (downcase a) (downcase b))
  5580.     (string-lessp a b)))
  5581.  
  5582. (defun gnus-date-lessp (date1 date2)
  5583.   "Return T if DATE1 is earlyer than DATE2."
  5584.   (string-lessp (gnus-sortable-date date1)
  5585.         (gnus-sortable-date date2)))
  5586.  
  5587. (defun gnus-sortable-date (date)
  5588.   "Make sortable string by string-lessp from DATE.
  5589. Timezone package is used."
  5590.   (let* ((date   (timezone-parse-date date)) ;[Y M D T]
  5591.      ;; #### would be faster to use read-from-string
  5592.      (year   (string-to-int (aref date 0)))
  5593.      (month  (string-to-int (aref date 1)))
  5594.      (day    (string-to-int (aref date 2)))
  5595.      (time   (aref date 3)))    ;HH:MM:SS
  5596.     ;; Timezone package is used.  But, we don't have to care about
  5597.     ;; the timezone since article's timezones are always GMT.
  5598.     (timezone-make-sortable-date year month day time)
  5599.     ))
  5600.  
  5601. ;;(defun gnus-sortable-date (date)
  5602. ;;  "Make sortable string by string-lessp from DATE."
  5603. ;;  (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
  5604. ;;         ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
  5605. ;;         ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
  5606. ;;         ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
  5607. ;;    (date (or date "")))
  5608. ;;    ;; Can understand the following styles:
  5609. ;;    ;; (1) 14 Apr 89 03:20:12 GMT
  5610. ;;    ;; (2) Fri, 17 Mar 89 4:01:33 GMT
  5611. ;;    (if (string-match
  5612. ;;     "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
  5613. ;;    (concat
  5614. ;;     ;; Year
  5615. ;;     (substring date (match-beginning 3) (match-end 3))
  5616. ;;     ;; Month
  5617. ;;     (cdr
  5618. ;;      (assoc
  5619. ;;       (upcase (substring date (match-beginning 2) (match-end 2))) month))
  5620. ;;     ;; Day
  5621. ;;     (format "%2d" (string-to-int
  5622. ;;            (substring date
  5623. ;;                   (match-beginning 1) (match-end 1))))
  5624. ;;     ;; Time
  5625. ;;     (substring date (match-beginning 4) (match-end 4)))
  5626. ;;      ;; Cannot understand DATE string.
  5627. ;;      date
  5628. ;;      )
  5629. ;;    ))
  5630.  
  5631. (defun gnus-fetch-field (field)
  5632.   "Return the value of the header FIELD of current article."
  5633.   (save-excursion
  5634.     (save-restriction
  5635.       (widen)
  5636.       (goto-char (point-min))
  5637.       (narrow-to-region (point-min)
  5638.             (progn (search-forward "\n\n" nil 'move) (point)))
  5639.       (mail-fetch-field field))))
  5640.  
  5641. (fset 'gnus-expunge 'gnus-summary-delete-marked-with)
  5642.  
  5643. (defun gnus-kill (field regexp &optional command all)
  5644.   "If FIELD of an article matches REGEXP, execute COMMAND.
  5645. Optional 1st argument COMMAND is default to
  5646.     (gnus-summary-mark-as-read nil \"X\").
  5647. If optional 2nd argument ALL is non-nil, articles marked are also applied to.
  5648. If FIELD is an empty string (or nil), entire article body is searched for.
  5649. COMMAND must be a lisp expression or a string representing a key sequence."
  5650.   ;; We don't want to change current point nor window configuration.
  5651.   (save-excursion
  5652.     (save-window-excursion
  5653.       ;; Selected window must be Summary buffer to execute keyboard
  5654.       ;; macros correctly. See command_loop_1.
  5655.       (switch-to-buffer gnus-summary-buffer 'norecord)
  5656.       (goto-char (point-min))        ;From the beginning.
  5657.       (if (null command)
  5658.       (setq command '(gnus-summary-mark-as-read nil "X")))
  5659.       ;; added by jwz; see gnus-apply-kill-file above.
  5660.       (setq command (list 'progn command
  5661.               '(setq gnus-killcount (1+ gnus-killcount))))
  5662.       (gnus-execute field regexp command nil (not all))
  5663.       )))
  5664.  
  5665. (defun gnus-execute (field regexp form &optional backward ignore-marked)
  5666.   "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
  5667. If FIELD is an empty string (or nil), entire article body is searched for.
  5668. If optional 1st argument BACKWARD is non-nil, do backward instead.
  5669. If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
  5670. marked as read or unread are ignored."
  5671.   (let ((function nil)
  5672.     ;;(header nil)
  5673.     (article nil))
  5674.     (if (string-equal field "")
  5675.     (setq field nil))
  5676.     (if (null field)
  5677.     nil
  5678.       (or (stringp field)
  5679.       (setq field (symbol-name field)))
  5680.       ;; Get access function of header filed.
  5681.       (setq function (intern-soft (concat "gnus-header-" (downcase field))))
  5682.       (if (and function (fboundp function))
  5683.       (setq function (symbol-function function))
  5684.     (error "Unknown header field: \"%s\"" field)))
  5685.     ;; Make FORM funcallable.
  5686.     (if (and (listp form) (not (eq (car form) 'lambda)))
  5687.     (setq form (list 'lambda nil form)))
  5688.     ;; Starting from the current article.
  5689.     (or (and ignore-marked
  5690.          ;; Articles marked as read and unread should be ignored.
  5691.          (setq article (gnus-summary-article-number))
  5692.          (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
  5693.          (memq article gnus-newsgroup-marked) ;Marked as unread.
  5694.          ))
  5695.     (gnus-execute-1 function regexp form))
  5696.     (while (gnus-summary-search-subject backward ignore-marked nil)
  5697.       (gnus-execute-1 function regexp form))
  5698.     ))
  5699.  
  5700.  
  5701. ;; It's not necessarily faster to call gnus-kill with one huge regexp than to
  5702. ;; call it multiple times.  In the first case, the more complicated the regexp
  5703. ;; is the longer it will take to compile it and search for it; and in the
  5704. ;; second case, the more kill-components there are, the more funcalls there
  5705. ;; are (and elisp function calls are really slow.)
  5706. ;;
  5707. ;; So gnus-execute-1 has been modified to accept lists of regexps, so that
  5708. ;; one can do:
  5709. ;;
  5710. ;;        (gnus-kill "Subject" '(
  5711. ;;          "pattern 1"
  5712. ;;          "pattern 2"
  5713. ;;          "pattern 3"
  5714. ;;          "pattern 4"
  5715. ;;          ))
  5716. ;;
  5717. ;; Each regexp is fast, but the iteration over them is made internally without
  5718. ;; extra funcalls.
  5719. ;;    - jwz, based on code by goehring@ai.mit.edu.
  5720.  
  5721. (defun gnus-execute-1 (function regexp form)
  5722.   (if (not (listp regexp))
  5723.       (setq regexp (list regexp)))
  5724.   (save-excursion
  5725.     ;; The point of Summary buffer must be saved during execution.
  5726.     (let ((article (gnus-summary-article-number)))
  5727.       (if (null article)
  5728.       nil                ;Nothing to do.
  5729.     (if function
  5730.         ;; Compare with header field.
  5731.         (let (;;(header (gnus-find-header-by-number
  5732.           ;;        gnus-newsgroup-headers article))
  5733.           (header (gnus-get-header-by-number article))
  5734.           (value nil))
  5735.           (and header
  5736.            (progn
  5737.              (setq value (funcall function header))
  5738.              ;; Number (Lines:) or symbol must be converted to string.
  5739.              (or (stringp value)
  5740.              (setq value (prin1-to-string value)))
  5741.              ;; changed by jwz
  5742. ;;             (string-match regexp value)
  5743.              (let ((re regexp)
  5744.                (match nil))
  5745.                (while (and re (not match))
  5746.              (setq match (string-match (car re) value)
  5747.                    re (cdr re)))
  5748.                match)
  5749.              )
  5750.            (if (stringp form)    ;Keyboard macro.
  5751.                (execute-kbd-macro form)
  5752.              (funcall form))))
  5753.       ;; Search article body.
  5754.       (let ((gnus-current-article nil) ;Save article pointer.
  5755.         (gnus-last-article nil)
  5756.         (gnus-break-pages nil)    ;No need to break pages.
  5757.         (gnus-mark-article-hook nil)) ;Inhibit marking as read.
  5758.         (message "Searching for article: %d..." article)
  5759.         (gnus-article-setup-buffer)
  5760. ;; changed by jwz to configure windows, ensure a summary line, and run hooks.
  5761. ;;        (gnus-article-prepare article t)
  5762.         (gnus-summary-display-article article t)
  5763. ;; changed by jwz
  5764.         (let ((re regexp)
  5765.           (match nil))
  5766.           (while (and re (not match))
  5767.         (if (setq match
  5768.               (save-excursion
  5769.                 (set-buffer gnus-article-buffer)
  5770.                 (goto-char (point-min))
  5771.                 (re-search-forward (car re) nil t)))
  5772.             (if (stringp form)    ;Keyboard macro.
  5773.             (execute-kbd-macro form)
  5774.               (funcall form))
  5775.           (setq re (cdr re))))))
  5776.       ))
  5777.       )))
  5778.  
  5779. ;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
  5780. ;;; modified by tower@prep Nov 86
  5781. ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
  5782.  
  5783. (defun gnus-caesar-region (&optional n)
  5784.   "Caesar rotation of region by N, default 13, for decrypting netnews.
  5785. ROT47 will be performed for Japanese text in any case."
  5786.   (interactive (if current-prefix-arg    ; Was there a prefix arg?
  5787.            (list (prefix-numeric-value current-prefix-arg))
  5788.          (list nil)))
  5789.   (cond ((not (numberp n)) (setq n 13))
  5790.     (t (setq n (mod n 26))))    ;canonicalize N
  5791.   (if (not (zerop n))        ; no action needed for a rot of 0
  5792.       (progn
  5793.     (if (or (not (boundp 'caesar-translate-table))
  5794.         (/= (aref caesar-translate-table ?a) (+ ?a n)))
  5795.         (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
  5796.           (message "Building caesar-translate-table...")
  5797.           (setq caesar-translate-table (make-vector 256 0))
  5798.           (while (< i 256)
  5799.         (aset caesar-translate-table i i)
  5800.         (setq i (1+ i)))
  5801.           (setq lower (concat lower lower) upper (upcase lower) i 0)
  5802.           (while (< i 26)
  5803.         (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
  5804.         (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
  5805.         (setq i (1+ i)))
  5806.           ;; ROT47 for Japanese text.
  5807.           ;; Thanks to ichikawa@flab.fujitsu.junet.
  5808.           (setq i 161)
  5809.           (let ((t1 (logior ?O 128))
  5810.             (t2 (logior ?! 128))
  5811.             (t3 (logior ?~ 128)))
  5812.         (while (< i 256)
  5813.           (aset caesar-translate-table i
  5814.             (let ((v (aref caesar-translate-table i)))
  5815.               (if (<= v t1) (if (< v t2) v (+ v 47))
  5816.                 (if (<= v t3) (- v 47) v))))
  5817.           (setq i (1+ i))))
  5818.           (message "Building caesar-translate-table... done")))
  5819.     (let ((from (region-beginning))
  5820.           (to (region-end))
  5821.           (i 0) str len)
  5822.       (setq str (buffer-substring from to))
  5823.       (setq len (length str))
  5824.       (while (< i len)
  5825.         (aset str i (aref caesar-translate-table (aref str i)))
  5826.         (setq i (1+ i)))
  5827.       (goto-char from)
  5828.       (delete-region from to)
  5829.       (insert str)))))
  5830.  
  5831. ;; Functions accessing headers.
  5832. ;; Functions are more convenient than macros in some case.
  5833.  
  5834. (defun gnus-header-number (header)
  5835.   "Return article number in HEADER."
  5836.   (nntp-header-number header))
  5837.  
  5838. (defun gnus-header-subject (header)
  5839.   "Return subject string in HEADER."
  5840.   (nntp-header-subject header))
  5841.  
  5842. (defun gnus-header-from (header)
  5843.   "Return author string in HEADER."
  5844.   (nntp-header-from header))
  5845.  
  5846. (defun gnus-header-xref (header)
  5847.   "Return xref string in HEADER."
  5848.   (nntp-header-xref header))
  5849.  
  5850. (defun gnus-header-lines (header)
  5851.   "Return lines in HEADER."
  5852.   (nntp-header-lines header))
  5853.  
  5854. (defun gnus-header-date (header)
  5855.   "Return date in HEADER."
  5856.   (nntp-header-date header))
  5857.  
  5858. (defun gnus-header-id (header)
  5859.   "Return Id in HEADER."
  5860.   (nntp-header-id header))
  5861.  
  5862. (defun gnus-header-references (header)
  5863.   "Return references in HEADER."
  5864.   (nntp-header-references header))
  5865.  
  5866.  
  5867. ;;;
  5868. ;;; Article savers.
  5869. ;;;
  5870.  
  5871. (defun gnus-output-to-rmail (file-name)
  5872.   "Append the current article to an Rmail file named FILE-NAME."
  5873.   (require 'rmail)
  5874.   ;; Most of these codes are borrowed from rmailout.el.
  5875.   (setq file-name (expand-file-name file-name))
  5876.   (setq rmail-last-rmail-file file-name)
  5877.   (let ((artbuf (current-buffer))
  5878.     (tmpbuf (get-buffer-create " *GNUS-output*")))
  5879.     (save-excursion
  5880.       (or (get-file-buffer file-name)
  5881.       (file-exists-p file-name)
  5882.       (if (yes-or-no-p
  5883.            (concat "\"" file-name "\" does not exist, create it? "))
  5884.           (let ((file-buffer (create-file-buffer file-name)))
  5885.         (save-excursion
  5886.           (set-buffer file-buffer)
  5887.           (rmail-insert-rmail-file-header)
  5888.           (let ((require-final-newline nil))
  5889.             (write-region (point-min) (point-max) file-name t 1)))
  5890.         (kill-buffer file-buffer))
  5891.         (error "Output file does not exist")))
  5892.       (set-buffer tmpbuf)
  5893.       (buffer-disable-undo (current-buffer))
  5894.       (erase-buffer)
  5895.       (insert-buffer-substring artbuf)
  5896.       (gnus-convert-article-to-rmail)
  5897.       ;; Decide whether to append to a file or to an Emacs buffer.
  5898.       (let ((outbuf (get-file-buffer file-name)))
  5899.     (if (not outbuf)
  5900.         (append-to-file (point-min) (point-max) file-name)
  5901.       ;; File has been visited, in buffer OUTBUF.
  5902.       (set-buffer outbuf)
  5903.       (let ((buffer-read-only nil)
  5904.         (msg (and (boundp 'rmail-current-message)
  5905.               rmail-current-message)))
  5906.         ;; If MSG is non-nil, buffer is in RMAIL mode.
  5907.         (if msg
  5908.         (progn (widen)
  5909.                (narrow-to-region (point-max) (point-max))))
  5910.         (insert-buffer-substring tmpbuf)
  5911.         (if msg
  5912.         (progn
  5913.           (goto-char (point-min))
  5914.           (widen)
  5915.           (search-backward "\^_")
  5916.           (narrow-to-region (point) (point-max))
  5917.           (goto-char (1+ (point-min)))
  5918.           (rmail-count-new-messages t)
  5919.           (rmail-show-message msg))))))
  5920.       )
  5921.     (kill-buffer tmpbuf)
  5922.     ))
  5923.  
  5924. (defun gnus-output-to-file (file-name)
  5925.   "Append the current article to a file named FILE-NAME."
  5926.   (setq file-name (expand-file-name file-name))
  5927.   (let ((artbuf (current-buffer))
  5928.     (tmpbuf (get-buffer-create " *GNUS-output*")))
  5929.     (save-excursion
  5930.       (set-buffer tmpbuf)
  5931.       (buffer-disable-undo (current-buffer))
  5932.       (erase-buffer)
  5933.       (insert-buffer-substring artbuf)
  5934.       ;; Append newline at end of the buffer as separator, and then
  5935.       ;; save it to file.
  5936.       (goto-char (point-max))
  5937.       (insert "\n")
  5938.       (append-to-file (point-min) (point-max) file-name))
  5939.     (kill-buffer tmpbuf)
  5940.     ))
  5941.  
  5942. (defun gnus-convert-article-to-rmail ()
  5943.   "Convert article in current buffer to Rmail message format."
  5944.   (let ((buffer-read-only nil))
  5945.     ;; Convert article directly into Babyl format.
  5946.     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
  5947.     (goto-char (point-min))
  5948.     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
  5949.     (while (search-forward "\n\^_" nil t) ;single char
  5950.       (replace-match "\n^_"))        ;2 chars: "^" and "_"
  5951.     (goto-char (point-max))
  5952.     (insert "\^_")))
  5953.  
  5954. ;;(defun gnus-convert-article-to-rmail ()
  5955. ;;  "Convert article in current buffer to Rmail message format."
  5956. ;;  (let ((buffer-read-only nil))
  5957. ;;    ;; Insert special header of Unix mail.
  5958. ;;    (goto-char (point-min))
  5959. ;;    (insert "From "
  5960. ;;        (or (mail-strip-quoted-names (mail-fetch-field "from"))
  5961. ;;        "unknown")
  5962. ;;        " " (current-time-string) "\n")
  5963. ;;    ;; Stop quoting `From' since this seems unnecessary in most cases.
  5964. ;;    ;; ``Quote'' "\nFrom " as "\n>From "
  5965. ;;    ;;(while (search-forward "\nFrom " nil t)
  5966. ;;    ;;  (forward-char -5)
  5967. ;;    ;;  (insert ?>))
  5968. ;;    ;; Convert article to babyl format.
  5969. ;;    (rmail-convert-to-babyl-format)
  5970. ;;    ))
  5971.  
  5972.  
  5973. ;;;
  5974. ;;; Internal functions.
  5975. ;;;
  5976.  
  5977. (defun gnus-start-news-server (&optional confirm)
  5978.   "Open network stream to remote NNTP server.
  5979. If optional argument CONFIRM is non-nil, ask you host that NNTP server
  5980. is running even if it is defined.
  5981. Run gnus-open-server-hook just before opening news server."
  5982.   (if (gnus-server-opened)
  5983.       ;; Stream is already opened.
  5984.       nil
  5985.     ;; Open NNTP server.
  5986.     (if (or confirm
  5987.         (null gnus-nntp-server))
  5988.     ;; If someone has set the service to nil, then this should always
  5989.     ;; be the local host.
  5990.     (if gnus-nntp-service
  5991.         (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
  5992.         ;; Read server name with completion.
  5993.         (setq gnus-nntp-server
  5994.               (completing-read "NNTP server: "
  5995.                        (cons (list gnus-nntp-server)
  5996.                          gnus-secondary-servers)
  5997.                        nil nil gnus-nntp-server))
  5998.           (setq gnus-nntp-server
  5999.             (read-string "NNTP server: " gnus-nntp-server)))
  6000.       (setq gnus-nntp-server "")))
  6001.     ;; If no server name is given, local host is assumed.
  6002.     (if (or (string-equal gnus-nntp-server "")
  6003.         (string-equal gnus-nntp-server "::")) ;RMS preference.
  6004.     (setq gnus-nntp-server (system-name)))
  6005.     ;; gnus-nntp-server must be either (system-name), ':DIRECTORY', or
  6006.     ;; nntp server name.  I mean '::' cannot be a value of
  6007.     ;; gnus-nntp-server.
  6008.     (cond ((and (null gnus-nntp-service)
  6009.         (string-equal gnus-nntp-server (system-name)))
  6010.        (require 'nnspool)
  6011.        (gnus-define-access-method 'nnspool)
  6012.        (message "Looking up local news spool..."))
  6013.       ((string-match ":" gnus-nntp-server)
  6014.        ;; :DIRECTORY
  6015.        (require 'mhspool)
  6016.        (gnus-define-access-method 'mhspool)
  6017.        (message "Looking up private directory..."))
  6018.       (t
  6019.        (gnus-define-access-method 'nntp)
  6020.        (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
  6021.     (run-hooks 'gnus-open-server-hook)
  6022.     (cond ((gnus-server-opened)        ;Maybe opened in gnus-open-server-hook.
  6023.        (message ""))
  6024.       ((gnus-open-server gnus-nntp-server gnus-nntp-service)
  6025.        (message ""))
  6026.       (t
  6027.        (error
  6028.         (gnus-nntp-message
  6029.          (format "Cannot open NNTP server on %s" gnus-nntp-server)))))
  6030.     ))
  6031.  
  6032. ;; Dummy functions used only once. Should return nil.
  6033. (defun gnus-server-opened () nil)
  6034. (defun gnus-close-server () nil)
  6035.  
  6036. (defun gnus-nntp-message (&optional message)
  6037.   "Return a message returned from NNTP server.
  6038. If no message is available and optional MESSAGE is given, return it."
  6039.   (let ((status (gnus-status-message))
  6040.     (message (or message "")))
  6041.     (if (and (stringp status)
  6042.          (> (length status) 0))
  6043.     status message)))
  6044.  
  6045. (defun gnus-define-access-method (method &optional access-methods)
  6046.   "Define access functions for the access METHOD.
  6047. Methods definition is taken from optional argument ACCESS-METHODS or
  6048. the variable gnus-access-methods."
  6049.   (let ((bindings
  6050.      (cdr (assoc method (or access-methods gnus-access-methods)))))
  6051.     (if (null bindings)
  6052.     (error "Unknown access method: %s" method)
  6053.       ;; Should not use symbol-function here since overload does not work.
  6054.       (while bindings
  6055.     ;; Alist syntax is different from that of 3.14.3.
  6056.     (fset (car (car bindings)) (car (cdr (car bindings))))
  6057.     (setq bindings (cdr bindings)))
  6058.       )))
  6059.  
  6060. (defun gnus-select-newsgroup (group &optional show-all)
  6061.   "Select newsgroup GROUP.
  6062. If optional argument SHOW-ALL is non-nil, all of articles in the group
  6063. are selected."
  6064.   ;; Make sure a connection to NNTP server is alive.
  6065.   (gnus-start-news-server)
  6066.   (if (gnus-request-group group)
  6067.       (let ((articles nil))
  6068.     (setq gnus-newsgroup-name group)
  6069.     (setq gnus-newsgroup-unreads
  6070.           (gnus-uncompress-sequence
  6071.            (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
  6072.     (cond (show-all
  6073.            ;; Select all active articles.
  6074.            (setq articles
  6075.              (gnus-uncompress-sequence
  6076.               (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
  6077.           (t
  6078.            ;; Select unread articles only.
  6079.            (setq articles gnus-newsgroup-unreads)))
  6080.     ;; Require confirmation if selecting large newsgroup.
  6081.     (setq gnus-newsgroup-unselected nil)
  6082.     (if (not (numberp gnus-large-newsgroup))
  6083.         nil
  6084.       (let ((selected nil)
  6085.         (number (length articles)))
  6086.         (if (> number gnus-large-newsgroup)
  6087.         (progn
  6088.           (condition-case ()
  6089.               (let ((input
  6090.                  (read-string
  6091.                   (format
  6092.                    "How many articles from %s (default %d): "
  6093.                    gnus-newsgroup-name number))))
  6094.             (setq selected
  6095.                   (if (string-equal input "")
  6096.                   number (string-to-int input))))
  6097.             (quit
  6098.              (setq selected 0)))
  6099.           (cond ((and (> selected 0)
  6100.                   (< selected number))
  6101.              ;; Select last N articles.
  6102.              (setq articles (nthcdr (- number selected) articles)))
  6103.             ((and (< selected 0)
  6104.                   (< (- 0 selected) number))
  6105.              ;; Select first N articles.
  6106.              (setq selected (- 0 selected))
  6107.              (setq articles (copy-sequence articles))
  6108.              (setcdr (nthcdr (1- selected) articles) nil))
  6109.             ((zerop selected)
  6110.              (setq articles nil))
  6111.             ;; Otherwise select all.
  6112.             )
  6113.           ;; Get unselected unread articles.
  6114.           (setq gnus-newsgroup-unselected
  6115.             (gnus-set-difference gnus-newsgroup-unreads articles))
  6116.           ))
  6117.         ))
  6118.     ;; Get headers list.
  6119.     (setq gnus-newsgroup-headers (gnus-retrieve-headers articles))
  6120.     ;; UNREADS may contain expired articles, so we have to remove
  6121.     ;;  them from the list.
  6122.     (setq gnus-newsgroup-unreads
  6123.           (gnus-intersection gnus-newsgroup-unreads
  6124.                  (mapcar
  6125.                   (function
  6126.                    (lambda (header)
  6127.                      (nntp-header-number header)))
  6128.                   gnus-newsgroup-headers)))
  6129.     ;; Marked article must be a subset of unread articles.
  6130.     (setq gnus-newsgroup-marked
  6131.           (gnus-intersection (append gnus-newsgroup-unselected
  6132.                      gnus-newsgroup-unreads)
  6133.                  (cdr
  6134.                   (gnus-gethash group gnus-marked-hashtb))))
  6135.     ;; First and last article in this newsgroup.
  6136.     (setq gnus-newsgroup-begin
  6137.           (if gnus-newsgroup-headers
  6138.           (nntp-header-number (car gnus-newsgroup-headers))
  6139.         0
  6140.         ))
  6141.     (setq gnus-newsgroup-end
  6142.           (if gnus-newsgroup-headers
  6143.           (nntp-header-number
  6144.            (gnus-last-element gnus-newsgroup-headers))
  6145.         0
  6146.         ))
  6147.     ;; File name that an article was saved last.
  6148.     (setq gnus-newsgroup-last-rmail nil)
  6149.     (setq gnus-newsgroup-last-mail nil)
  6150.     (setq gnus-newsgroup-last-folder nil)
  6151.     (setq gnus-newsgroup-last-file nil)
  6152.     ;; Reset article pointer etc.
  6153.     (setq gnus-current-article nil)
  6154.     (setq gnus-current-headers nil)
  6155.     (setq gnus-current-history nil)
  6156.     (setq gnus-have-all-headers nil)
  6157.     (setq gnus-last-article nil)
  6158.     ;; Clear old hash tables for the variable gnus-newsgroup-headers.
  6159.     (gnus-clear-hashtables-for-newsgroup-headers)
  6160.     ;; GROUP is successfully selected.
  6161.     t
  6162.     )
  6163.     ))
  6164.  
  6165. ;; Hacking for making header search much faster.
  6166.  
  6167. (defun gnus-get-header-by-number (number)
  6168.   "Return a header specified by a NUMBER.
  6169. If the variable gnus-newsgroup-headers is updated, the hashed table
  6170. gnus-newsgroup-headers-hashtb-by-number must be set to nil to indicate
  6171. rehash is necessary."
  6172.   (or gnus-newsgroup-headers-hashtb-by-number
  6173.       (gnus-make-headers-hashtable-by-number))
  6174.   (gnus-gethash (int-to-string number)
  6175.         gnus-newsgroup-headers-hashtb-by-number))
  6176.  
  6177. (defun gnus-get-header-by-id (id)
  6178.   "Return a header specified by an ID.
  6179. If the variable gnus-newsgroup-headers is updated, the hashed table
  6180. gnus-newsgroup-headers-hashtb-by-id must be set to nil to indicate
  6181. rehash is necessary."
  6182.   (or gnus-newsgroup-headers-hashtb-by-id
  6183.       (gnus-make-headers-hashtable-by-id))
  6184.   (and (stringp id)
  6185.        (gnus-gethash id gnus-newsgroup-headers-hashtb-by-id)))
  6186.  
  6187. (defun gnus-make-headers-hashtable-by-number ()
  6188.   "Make hashtable for the variable gnus-newsgroup-headers by number."
  6189.   (let ((header nil)
  6190.     (headers gnus-newsgroup-headers))
  6191.     (setq gnus-newsgroup-headers-hashtb-by-number
  6192.       (gnus-make-hashtable (length headers)))
  6193.     (while headers
  6194.       (setq header (car headers))
  6195.       (gnus-sethash (int-to-string (nntp-header-number header))
  6196.             header gnus-newsgroup-headers-hashtb-by-number)
  6197.       (setq headers (cdr headers))
  6198.       )))
  6199.  
  6200. (defun gnus-make-headers-hashtable-by-id ()
  6201.   "Make hashtable for the variable gnus-newsgroup-headers by id."
  6202.   (let ((header nil)
  6203.     (headers gnus-newsgroup-headers))
  6204.     (setq gnus-newsgroup-headers-hashtb-by-id
  6205.       (gnus-make-hashtable (length headers)))
  6206.     (while headers
  6207.       (setq header (car headers))
  6208.       (gnus-sethash (nntp-header-id header)
  6209.             header gnus-newsgroup-headers-hashtb-by-id)
  6210.       (setq headers (cdr headers))
  6211.       )))
  6212.  
  6213. (defun gnus-clear-hashtables-for-newsgroup-headers ()
  6214.   "Clear hash tables created for the variable gnus-newsgroup-headers."
  6215.   (setq gnus-newsgroup-headers-hashtb-by-id nil)
  6216.   (setq gnus-newsgroup-headers-hashtb-by-number nil))
  6217.  
  6218. (defun gnus-more-header-backward ()
  6219.   "Find new header backward."
  6220.   (let ((first
  6221.      (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
  6222.     (artnum gnus-newsgroup-begin)
  6223.     (header nil))
  6224.     (while (and (not header)
  6225.         (> artnum first))
  6226.       (setq artnum (1- artnum))
  6227.       (setq header (car (gnus-retrieve-headers (list artnum)))))
  6228.     header
  6229.     ))
  6230.  
  6231. (defun gnus-more-header-forward ()
  6232.   "Find new header forward."
  6233.   (let ((last
  6234.      (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
  6235.     (artnum gnus-newsgroup-end)
  6236.     (header nil))
  6237.     (while (and (not header)
  6238.         (< artnum last))
  6239.       (setq artnum (1+ artnum))
  6240.       (setq header (car (gnus-retrieve-headers (list artnum)))))
  6241.     header
  6242.     ))
  6243.  
  6244. (defun gnus-extend-newsgroup (header &optional backward)
  6245.   "Extend newsgroup selection with HEADER.
  6246. Optional argument BACKWARD means extend toward backward."
  6247.   (if header
  6248.       (let ((artnum (nntp-header-number header)))
  6249.     (setq gnus-newsgroup-headers
  6250.           (if backward
  6251.           (cons header gnus-newsgroup-headers)
  6252.         (append gnus-newsgroup-headers (list header))))
  6253.     ;; Clear current hash tables for the variable gnus-newsgroup-headers.
  6254.     (gnus-clear-hashtables-for-newsgroup-headers)
  6255.     ;; We have to update unreads and unselected, but don't have to
  6256.     ;; care about gnus-newsgroup-marked.
  6257.     (if (memq artnum gnus-newsgroup-unselected)
  6258.         (setq gnus-newsgroup-unreads
  6259.           (cons artnum gnus-newsgroup-unreads)))
  6260.     (setq gnus-newsgroup-unselected
  6261.           (delq artnum gnus-newsgroup-unselected))
  6262.     (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
  6263.     (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
  6264.     )))
  6265.  
  6266. (defun gnus-mark-article-as-read (article)
  6267.   "Remember that ARTICLE is marked as read."
  6268.   ;; Remove from unread and marked list.
  6269.   (setq gnus-newsgroup-unreads
  6270.     (delq article gnus-newsgroup-unreads))
  6271.   (setq gnus-newsgroup-marked
  6272.     (delq article gnus-newsgroup-marked)))
  6273.  
  6274. (defun gnus-mark-article-as-unread (article &optional clear-mark)
  6275.   "Remember that ARTICLE is marked as unread.
  6276. Optional argument CLEAR-MARK means ARTICLE should not be remembered
  6277. that it was marked as read once."
  6278.   ;; Add to unread list.
  6279.   (or (memq article gnus-newsgroup-unreads)
  6280.       (setq gnus-newsgroup-unreads
  6281.         (cons article gnus-newsgroup-unreads)))
  6282.   ;; If CLEAR-MARK is non-nil, the article must be removed from marked
  6283.   ;; list.  Otherwise, it must be added to the list.
  6284.   (if clear-mark
  6285.       (setq gnus-newsgroup-marked
  6286.         (delq article gnus-newsgroup-marked))
  6287.     (or (memq article gnus-newsgroup-marked)
  6288.     (setq gnus-newsgroup-marked
  6289.           (cons article gnus-newsgroup-marked)))))
  6290.  
  6291. (defun gnus-clear-system ()
  6292.   "Clear all variables and buffer."
  6293.   ;; Clear GNUS variables.
  6294.   (let ((variables gnus-variable-list))
  6295.     (while variables
  6296.       (set (car variables) nil)
  6297.       (setq variables (cdr variables))))
  6298.   ;; Clear other internal variables.
  6299.   (setq gnus-newsrc-hashtb nil)
  6300.   (setq gnus-marked-hashtb nil)
  6301.   (setq gnus-killed-hashtb nil)
  6302.   (setq gnus-active-hashtb nil)
  6303.   (setq gnus-octive-hashtb nil)
  6304.   (setq gnus-unread-hashtb nil)
  6305.   (setq gnus-newsgroup-headers nil)
  6306.   (setq gnus-newsgroup-headers-hashtb-by-id nil)
  6307.   (setq gnus-newsgroup-headers-hashtb-by-number nil)
  6308.   ;; Kill the startup file.
  6309.   (and gnus-current-startup-file
  6310.        (get-file-buffer gnus-current-startup-file)
  6311.        (kill-buffer (get-file-buffer gnus-current-startup-file)))
  6312.   (setq gnus-current-startup-file nil)
  6313.   ;; Kill GNUS buffers.
  6314.   (let ((buffers gnus-buffer-list))
  6315.     (while buffers
  6316.       (if (get-buffer (car buffers))
  6317.       (kill-buffer (car buffers)))
  6318.       (setq buffers (cdr buffers))
  6319.       )))
  6320.  
  6321. (defun gnus-configure-windows (action)
  6322.   "Configure GNUS windows according to the next ACTION.
  6323. The ACTION is either a symbol, such as `summary', or a
  6324. configuration list such as `(1 1 2)'.  If ACTION is not a list,
  6325. configuration list is got from the variable gnus-window-configuration."
  6326.   (let* ((windows
  6327.       (if (listp action)
  6328.           action (car (cdr (assq action gnus-window-configuration)))))
  6329.      (grpwin (get-buffer-window gnus-group-buffer))
  6330.      (subwin (get-buffer-window gnus-summary-buffer))
  6331.      (artwin (get-buffer-window gnus-article-buffer))
  6332.      (winsum nil)
  6333.          ;; XEmacs change
  6334.      (new-height 0)
  6335.      (height nil)
  6336.      (grpheight 0)
  6337.      (subheight 0)
  6338.      (artheight 0))
  6339.  
  6340.     ;; XEmacs change -- things assume this exists
  6341.     ;; If Article buffer does not exist, it will be created
  6342.     ;; and initialized.
  6343.     (gnus-article-setup-buffer)
  6344.  
  6345.     (if (or (null windows)        ;No configuration is specified.
  6346.         (and (eq (null grpwin)
  6347.              (zerop (nth 0 windows)))
  6348.          (eq (null subwin)
  6349.              (zerop (nth 1 windows)))
  6350.          (eq (null artwin)
  6351.              (zerop (nth 2 windows)))))
  6352.     ;; No need to change window configuration.
  6353.     nil
  6354.       (select-window (or grpwin subwin artwin (selected-window)))
  6355.       ;; First of all, compute the height of each window.
  6356.       (cond (gnus-use-full-window
  6357.          ;; Take up the entire screen.
  6358.          (delete-other-windows)
  6359.          (setq height (window-height (selected-window))))
  6360.         (t
  6361.          (setq height (+ (if grpwin (window-height grpwin) 0)
  6362.                  (if subwin (window-height subwin) 0)
  6363.                  (if artwin (window-height artwin) 0)))))
  6364.       ;; The Newsgroup buffer exits always. So, use it to extend the
  6365.       ;; Group window so as to get enough window space.
  6366.       (switch-to-buffer gnus-group-buffer 'norecord)
  6367.       (and (get-buffer gnus-summary-buffer)
  6368.        (delete-windows-on gnus-summary-buffer))
  6369.       (and (get-buffer gnus-article-buffer)
  6370.        (delete-windows-on gnus-article-buffer))
  6371.       ;; Compute expected window height.
  6372.       (setq winsum (apply (function +) windows))
  6373.       (if (not (zerop (nth 0 windows)))
  6374.       (setq grpheight (max window-min-height
  6375.                    (/ (* height (nth 0 windows)) winsum))))
  6376.       (if (not (zerop (nth 1 windows)))
  6377.       (setq subheight (max window-min-height
  6378.                    (/ (* height (nth 1 windows)) winsum))))
  6379.       (if (not (zerop (nth 2 windows)))
  6380.       (setq artheight (max window-min-height
  6381.                    (/ (* height (nth 2 windows)) winsum))))
  6382.  
  6383.       ;; XEmacs change
  6384.       (setq new-height (+ grpheight subheight artheight))
  6385.       ;; new-height and height "should" be the same, but they aren't because
  6386.       ;; of integer-roundoff.  So take the remainder and add it to the end
  6387.       ;; of the bottommost window.
  6388.       (or (= new-height height)
  6389.        (cond ((not (zerop artheight))
  6390.           (setq artheight (+ artheight (- height new-height))))
  6391.          ((not (zerop subheight))
  6392.           (setq subheight (+ subheight (- height new-height))))
  6393.          (t ; (not (zerop grpheight))
  6394.           (setq grpheight (+ grpheight (- height new-height))))))
  6395.       (let ((offset (- height (window-height (selected-window)))))
  6396.      (if (> offset 0) (enlarge-window offset)))
  6397.  
  6398.       ;; Then split the window.
  6399.       (and (not (zerop artheight))
  6400.        (or (not (zerop grpheight))
  6401.            (not (zerop subheight)))
  6402.        (split-window nil (+ grpheight subheight)))
  6403.       (and (not (zerop grpheight))
  6404.        (not (zerop subheight))
  6405.        (split-window nil grpheight))
  6406.       ;; Then select buffers in each window.
  6407.       (and (not (zerop grpheight))
  6408.        (progn
  6409.          (switch-to-buffer gnus-group-buffer 'norecord)
  6410.          (other-window 1)))
  6411.       (and (not (zerop subheight))
  6412.        (progn
  6413.          (switch-to-buffer gnus-summary-buffer 'norecord)
  6414.          (other-window 1)))
  6415.       (and (not (zerop artheight))
  6416.        (progn
  6417.          (switch-to-buffer gnus-article-buffer 'norecord)))
  6418.       )
  6419.     ))
  6420.  
  6421. (defun gnus-find-header-by-number (headers number)
  6422.   "Return a header which is a element of HEADERS and has NUMBER."
  6423.   (let ((found nil))
  6424.     (while (and headers (not found))
  6425.       ;; We cannot use `=' to accept non-numeric NUMBER.
  6426.       (if (eq number (nntp-header-number (car headers)))
  6427.       (setq found (car headers)))
  6428.       (setq headers (cdr headers)))
  6429.     found
  6430.     ))
  6431.  
  6432. (defun gnus-find-header-by-id (headers id)
  6433.   "Return a header which is a element of HEADERS and has Message-ID."
  6434.   (let ((found nil))
  6435.     (while (and headers (not found))
  6436.       (if (string-equal id (nntp-header-id (car headers)))
  6437.       (setq found (car headers)))
  6438.       (setq headers (cdr headers)))
  6439.     found
  6440.     ))
  6441.  
  6442. (defun gnus-version ()
  6443.   "Version numbers of this version of GNUS."
  6444.   (interactive)
  6445.   (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
  6446.      (message "%s; %s; %s; %s"
  6447.           gnus-version nntp-version nnspool-version mhspool-version))
  6448.     ((boundp 'mhspool-version)
  6449.      (message "%s; %s; %s"
  6450.           gnus-version nntp-version mhspool-version))
  6451.     ((boundp 'nnspool-version)
  6452.      (message "%s; %s; %s"
  6453.           gnus-version nntp-version nnspool-version))
  6454.     (t
  6455.      (message "%s; %s" gnus-version nntp-version))))
  6456.  
  6457. (defun gnus-info-find-node ()
  6458.   "Find Info documentation of GNUS."
  6459.   (interactive)
  6460.   (require 'info)
  6461.   ;; Enlarge info window if needed.
  6462.   (cond ((eq major-mode 'gnus-group-mode)
  6463.      (gnus-configure-windows '(1 0 0)) ;Take all windows.
  6464.      (gnus-pop-to-buffer gnus-group-buffer))
  6465.     ((eq major-mode 'gnus-summary-mode)
  6466.      (gnus-configure-windows '(0 1 0)) ;Take all windows.
  6467.      (gnus-pop-to-buffer gnus-summary-buffer)))
  6468.   (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes)))))
  6469.  
  6470. (defun gnus-overload-functions (&optional overloads)
  6471.   "Overload functions specified by optional argument OVERLOADS.
  6472. If nothing is specified, use the variable gnus-overload-functions."
  6473.   (let ((defs nil)
  6474.     (overloads (or overloads gnus-overload-functions)))
  6475.     (while overloads
  6476.       (setq defs (car overloads))
  6477.       (setq overloads (cdr overloads))
  6478.       ;; Load file before overloading function if necessary.  Make
  6479.       ;; sure we cannot use `require' always.
  6480.       (and (not (fboundp (car defs)))
  6481.        (car (cdr (cdr defs)))
  6482.        (load (car (cdr (cdr defs))) nil 'nomessage))
  6483.       (fset (car defs) (car (cdr defs)))
  6484.       )))
  6485.  
  6486. ;; XEmacs change: faster version of this from Scott Snyder
  6487. (defun gnus-make-threads (newsgroup-headers)
  6488.   "Make conversation threads tree from NEWSGROUP-HEADERS."
  6489.   (message "Threading...")
  6490.   (let ((headers newsgroup-headers)
  6491.     (refer nil)
  6492.     (d nil)
  6493.     (h nil)
  6494.     (roots nil)
  6495.     (dlist nil)
  6496.     (dependencies (gnus-make-hashtable)))
  6497.  
  6498.     ;; Build a table hashing message IDs to a list of the messages which
  6499.     ;; have that message ID as a parent.  The list is extended with setcdr.
  6500.     (mapcar (function (lambda (header)
  6501.             (gnus-sethash (nntp-header-id header) (list header)
  6502.                       dependencies)))
  6503.         newsgroup-headers)
  6504.  
  6505.     ;; Make message dependency alist.
  6506.     (while headers
  6507.       (setq h (car headers))
  6508.       (setq headers (cdr headers))
  6509.       ;; Ignore invalid headers.
  6510.       (if (vectorp h)            ;Depends on nntp.el.
  6511.       (progn
  6512.         ;; Ignore broken references, e.g "<123@a.b.c".
  6513.         (setq refer (nntp-header-references h))
  6514.         (setq dlist (and refer
  6515.                  (string-match "\\(<[^<>]+>\\)[^>]*$" refer)
  6516.                  (gnus-gethash
  6517.                   (substring refer
  6518.                      (match-beginning 1) (match-end 1))
  6519.                   dependencies)))
  6520.         (setq d (car dlist))
  6521.         ;; Check subject equality.
  6522.         (or gnus-thread-ignore-subject
  6523.         (null d)
  6524.         (string-equal (gnus-simplify-subject
  6525.                    (nntp-header-subject h) 're)
  6526.                   (gnus-simplify-subject
  6527.                    (nntp-header-subject d) 're))
  6528.         ;; H should be a thread root.
  6529.         (setq d nil))
  6530.         (if d
  6531.         ;; H depends on D.
  6532.         (setcdr dlist (cons h (cdr dlist)))
  6533.           ;; H is a thread root.
  6534.           (setq roots (cons h roots)))
  6535.         ))
  6536.       )
  6537.     ;; Make complete threads from the roots.
  6538.     ;; Note: values in dependencies are in reverse order, but
  6539.     ;; gnus-make-threads-1 processes them in reverse order again.
  6540.     ;; So, we don't have to worry about it.
  6541.     (prog1
  6542.     (mapcar (function (lambda (root)
  6543.                 (gnus-make-threads-1 root dependencies)))
  6544.         (nreverse roots))
  6545.       (message "Threading... done"))))
  6546.  
  6547. (defun gnus-make-threads-1 (parent dependencies)
  6548.   (cons parent
  6549.     (mapcar (function
  6550.          (lambda (child)
  6551.            (gnus-make-threads-1 child dependencies)))
  6552.         (nreverse (cdr (gnus-gethash (nntp-header-id parent)
  6553.                          dependencies))))))
  6554.  
  6555.  
  6556. (defun gnus-narrow-to-page (&optional arg)
  6557.   "Make text outside current page invisible except for page delimiter.
  6558. A numeric arg specifies to move forward or backward by that many pages,
  6559. thus showing a page other than the one point was originally in."
  6560.   (interactive "P")
  6561.   (setq arg (if arg (prefix-numeric-value arg) 0))
  6562.   (save-excursion
  6563.     (forward-page -1)            ;Beginning of current page.
  6564.     (widen)
  6565.     (if (> arg 0)
  6566.     (forward-page arg)
  6567.       (if (< arg 0)
  6568.       (forward-page (1- arg))))
  6569.     ;; Find the end of the page.
  6570.     (forward-page)
  6571.     ;; If we stopped due to end of buffer, stay there.
  6572.     ;; If we stopped after a page delimiter, put end of restriction
  6573.     ;; at the beginning of that line.
  6574.     ;; These are commented out.
  6575.     ;;    (if (save-excursion (beginning-of-line)
  6576.     ;;            (looking-at page-delimiter))
  6577.     ;;    (beginning-of-line))
  6578.     (narrow-to-region (point)
  6579.               (progn
  6580.             ;; Find the top of the page.
  6581.             (forward-page -1)
  6582.             ;; If we found beginning of buffer, stay there.
  6583.             ;; If extra text follows page delimiter on same line,
  6584.             ;; include it.
  6585.             ;; Otherwise, show text starting with following line.
  6586.             (if (and (eolp) (not (bobp)))
  6587.                 (forward-line 1))
  6588.             (point)))
  6589.     ))
  6590.  
  6591. ;; Create hash table for alist, such as gnus-newsrc-assoc,
  6592. ;; gnus-killed-assoc, and gnus-marked-assoc.
  6593.  
  6594. (defun gnus-make-hashtable-from-alist (alist &optional hashsize)
  6595.   "Return hash table for ALIST.
  6596. Optional argument HASHSIZE specifies the hashtable size.
  6597. Hash key is a car of alist element, which must be a string."
  6598.   (let ((hashtb (gnus-make-hashtable (or hashsize (length alist)))))
  6599.     (while alist
  6600.       (gnus-sethash (car (car alist))    ;Newsgroup name
  6601.             (car alist)        ;Alist element
  6602.             hashtb)
  6603.       (setq alist (cdr alist)))
  6604.     hashtb
  6605.     ))
  6606.  
  6607. (defun gnus-last-element (list)
  6608.   "Return last element of LIST."
  6609.   (let ((last nil))
  6610.     (while list
  6611.       (if (null (cdr list))
  6612.       (setq last (car list)))
  6613.       (setq list (cdr list)))
  6614.     last
  6615.     ))
  6616.  
  6617. (defun gnus-set-difference (list1 list2)
  6618.   "Return a list of elements of LIST1 that do not appear in LIST2."
  6619.   (let ((list1 (copy-sequence list1)))
  6620.     (while list2
  6621.       (setq list1 (delq (car list2) list1))
  6622.       (setq list2 (cdr list2)))
  6623.     list1
  6624.     ))
  6625.  
  6626. (defun gnus-intersection (list1 list2)
  6627.   "Return a list of elements that appear in both LIST1 and LIST2."
  6628.   (let ((result nil))
  6629.     (while list2
  6630.       (if (memq (car list2) list1)
  6631.       (setq result (cons (car list2) result)))
  6632.       (setq list2 (cdr list2)))
  6633.     result
  6634.     ))
  6635.  
  6636.  
  6637. ;;;
  6638. ;;; Get information about active articles, already read articles, and
  6639. ;;;  still unread articles.
  6640. ;;;
  6641.  
  6642. ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
  6643. ;; (("general" t (1 . 1))
  6644. ;;  ("misc"    t (1 . 10) (12 . 15))
  6645. ;;  ("test"  nil (1 . 99)) ...)
  6646. ;; GNUS internal format of gnus-marked-assoc:
  6647. ;; (("general" 1 2 3)
  6648. ;;  ("misc" 2) ...)
  6649. ;; GNUS internal format of gnus-active-hashtb:
  6650. ;; (("general" t (1 . 1))
  6651. ;;  ("misc"    t (1 . 10))
  6652. ;;  ("test"  nil (1 . 99)) ...)
  6653. ;; GNUS internal format of gnus-unread-hashtb:
  6654. ;; (("general" 1 (1 . 1))
  6655. ;;  ("misc"   14 (1 . 10) (12 . 15))
  6656. ;;  ("test"   99 (1 . 99)) ...)
  6657.  
  6658. (defun gnus-setup-news (&optional rawfile)
  6659.   "Setup news information.
  6660. If optional argument RAWFILE is non-nil, force to read raw startup file."
  6661.   (let ((init (not (and gnus-newsrc-assoc
  6662.             gnus-active-hashtb
  6663.             gnus-unread-hashtb
  6664.             (not rawfile)
  6665.             ))))
  6666.     ;; We have to clear some variables to re-initialize news info.
  6667.     (if init
  6668.     (setq gnus-newsrc-assoc nil
  6669.           gnus-active-hashtb nil
  6670.           gnus-unread-hashtb nil))
  6671.     (gnus-read-active-file)
  6672.     ;; Initialize only once.
  6673.     (if init
  6674.     (progn
  6675.       ;; Get distributions only once.
  6676.       (gnus-read-distributions-file)
  6677.       ;; newsrc file must be read after reading active file since
  6678.       ;; its size is used to guess the size of gnus-newsrc-hashtb.
  6679.       (gnus-read-newsrc-file rawfile)
  6680.       ))
  6681.     (gnus-expire-marked-articles)
  6682.     (gnus-get-unread-articles)
  6683.     ;; Check new newsgroups and subscribe them.
  6684.     (if init
  6685.     (let ((new-newsgroups (gnus-find-new-newsgroups)))
  6686.       (if (> (length new-newsgroups) 20) ; jwz says 20 is a lot
  6687.           (gnus-subscribe-many new-newsgroups)
  6688.         (while new-newsgroups
  6689.           (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
  6690.           (setq new-newsgroups (cdr new-newsgroups))
  6691.           ))))
  6692.     ))
  6693.  
  6694. (defun gnus-add-newsgroup (newsgroup)
  6695.   "Subscribe new NEWSGROUP safely and put it at top."
  6696.   (and (null (gnus-gethash newsgroup gnus-newsrc-hashtb)) ;Really new?
  6697.        (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
  6698.        (gnus-insert-newsgroup (or (gnus-gethash newsgroup gnus-killed-hashtb)
  6699.                   (list newsgroup t))
  6700.                   (car (car gnus-newsrc-assoc)))))
  6701.  
  6702. (defun gnus-find-new-newsgroups ()
  6703.   "Looking for new newsgroups and return names.
  6704. `-n' option of options line in .newsrc file is recognized."
  6705.   (let ((group nil)
  6706.     (new-newsgroups nil))
  6707.     (mapatoms
  6708.      (function
  6709.       (lambda (sym)
  6710.     (setq group (symbol-name sym))
  6711.     ;; Taking account of `-n' option.
  6712.     (and (or (null gnus-newsrc-options-n-no)
  6713.          (not (string-match gnus-newsrc-options-n-no group))
  6714.          (and gnus-newsrc-options-n-yes
  6715.               (string-match gnus-newsrc-options-n-yes group)))
  6716.          (null (gnus-gethash group gnus-killed-hashtb)) ;Ignore killed.
  6717.          (null (gnus-gethash group gnus-newsrc-hashtb)) ;Really new.
  6718.          ;; Find new newsgroup.
  6719.          (setq new-newsgroups
  6720.            (cons group new-newsgroups)))
  6721.     ))
  6722.      gnus-active-hashtb)
  6723.     ;; Return new newsgroups.
  6724.     new-newsgroups
  6725.     ))
  6726.  
  6727. (defun gnus-kill-newsgroup (group)
  6728.   "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."
  6729.   (let ((info (gnus-gethash group gnus-newsrc-hashtb)))
  6730.     (if (null info)
  6731.     nil
  6732.       ;; Delete from gnus-newsrc-assoc and gnus-newsrc-hashtb.
  6733.       (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
  6734.       (gnus-sethash group nil gnus-newsrc-hashtb)
  6735.       ;; Add to gnus-killed-assoc and gnus-killed-hashtb.
  6736.       (setq gnus-killed-assoc
  6737.         (cons info
  6738.           (delq (gnus-gethash group gnus-killed-hashtb)
  6739.             gnus-killed-assoc)))
  6740.       (gnus-sethash group info gnus-killed-hashtb)
  6741.       ;; Clear unread hashtable.
  6742.       ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
  6743.       (gnus-sethash group nil gnus-unread-hashtb)
  6744.       ;; Then delete from .newsrc
  6745.       (gnus-update-newsrc-buffer group 'delete)
  6746.       ;; Return the deleted newsrc entry.
  6747.       info
  6748.       )))
  6749.  
  6750. (defun gnus-insert-newsgroup (info &optional next)
  6751.   "Insert newsrc INFO entry before NEXT.
  6752. If optional argument NEXT is nil, appended to the last."
  6753.   (if (null info)
  6754.       (error "Invalid argument: %s" info))
  6755.   (let* ((group (car info))        ;Newsgroup name.
  6756.      (range
  6757.       (gnus-difference-of-range
  6758.        (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
  6759.     ;; Check duplication.
  6760.     (if (gnus-gethash group gnus-newsrc-hashtb)
  6761.     (error "Duplicated: %s" group))
  6762.     ;; Insert to gnus-newsrc-assoc and gnus-newsrc-hashtb.
  6763.     (if (string-equal next (car (car gnus-newsrc-assoc)))
  6764.     (setq gnus-newsrc-assoc
  6765.           (cons info gnus-newsrc-assoc))
  6766.       (let ((found nil)
  6767.         (rest (cdr gnus-newsrc-assoc))
  6768.         (tail gnus-newsrc-assoc))
  6769.     ;; Seach insertion point.
  6770.     (while (and (not found) rest)
  6771.       (if (string-equal next (car (car rest)))
  6772.           (setq found t)
  6773.         (setq rest (cdr rest))
  6774.         (setq tail (cdr tail))
  6775.         ))
  6776.     ;; Find it.
  6777.     (if (consp tail)
  6778.         (setcdr tail (cons info rest))
  6779.       ;; gnus-newsrc-assoc must be nil.
  6780.       (setq gnus-newsrc-assoc
  6781.         (append gnus-newsrc-assoc (cons info rest))))
  6782.     ))
  6783.     (gnus-sethash group info gnus-newsrc-hashtb)
  6784.     ;; Delete from gnus-killed-assoc and gnus-killed-hashtb.
  6785.     (setq gnus-killed-assoc
  6786.       (delq (gnus-gethash group gnus-killed-hashtb) gnus-killed-assoc))
  6787.     (gnus-sethash group nil gnus-killed-hashtb)
  6788.     ;; Then insert to .newsrc.
  6789.     (gnus-update-newsrc-buffer group nil next)
  6790.     ;; Add to gnus-unread-hashtb.
  6791.     (gnus-sethash group
  6792.           (cons group        ;Newsgroup name.
  6793.             (cons (gnus-number-of-articles range) range))
  6794.           gnus-unread-hashtb)
  6795.     ))
  6796.  
  6797.  
  6798. ;; XEmacs addition: this is much, much faster than iterating over
  6799. ;; gnus-insert-newsgroup.
  6800. (defun gnus-insert-new-newsgroups (groups subscribed-p)
  6801.   "Insert newsrc info entries for the newsgroups.
  6802. The newsgroups had better not exist already when this is called!"
  6803.   (let ((new-info nil)
  6804.     (total (length groups))
  6805.     (count 0)
  6806.     (fmt (if subscribed-p
  6807.          "Subscribing new newsgroups... %d%%"
  6808.          "Unsubscribing new newsgroups... %d%%"))
  6809.     group range)
  6810.     (save-excursion
  6811.       (set-buffer (or (get-file-buffer gnus-current-startup-file)
  6812.               (find-file-noselect gnus-current-startup-file)))
  6813.       (goto-char (point-max))
  6814.       (while groups
  6815.     (setq group (car groups))
  6816.     (setq new-info
  6817.           (cons (list group
  6818.               (or subscribed-p
  6819.                   (if (string-match gnus-subscribe-default-groups
  6820.                         group)
  6821.                   t)))
  6822.             new-info))
  6823.     (gnus-sethash group (car new-info) gnus-newsrc-hashtb)
  6824.  
  6825.     ;;(gnus-update-newsrc-buffer group nil nil)
  6826.     (insert group)
  6827.     (insert (if (nth 1 (car new-info)) ":\n" "!\n"))
  6828.  
  6829.     ;; Add to gnus-unread-hashtb.
  6830.     (setq range (nth 2 (gnus-gethash group gnus-active-hashtb)))
  6831.     (gnus-sethash group
  6832.               (cons group
  6833.                 (cons (if (= (cdr range) 0) ; grody...
  6834.                       0
  6835.                     (- (cdr range) (car range)))
  6836.                   (list range)))
  6837.               gnus-unread-hashtb)
  6838.       
  6839.     (gnus-lazy-message fmt (/ count total))
  6840.     (setq count (+ count 100))
  6841.     (setq groups (cdr groups))))
  6842.     (setq gnus-newsrc-assoc (nconc gnus-newsrc-assoc (nreverse new-info)))
  6843.     ))
  6844.  
  6845. (defun gnus-check-killed-newsgroups ()
  6846.   "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc.
  6847. gnus-killed-hashtb is also updated."
  6848.   (let ((group nil)
  6849.     (new-killed nil)
  6850.     (old-killed gnus-killed-assoc))
  6851.     (while old-killed
  6852.       (setq group (car (car old-killed)))
  6853.       (and (or (null gnus-newsrc-options-n-no)
  6854.            (not (string-match gnus-newsrc-options-n-no group))
  6855.            (and gnus-newsrc-options-n-yes
  6856.             (string-match gnus-newsrc-options-n-yes group)))
  6857.        (null (gnus-gethash group gnus-newsrc-hashtb)) ;No duplication.
  6858.        ;; Subscribed in options line and not in gnus-newsrc-assoc.
  6859.        (setq new-killed
  6860.          (cons (car old-killed) new-killed)))
  6861.       (setq old-killed (cdr old-killed))
  6862.       )
  6863.     (setq gnus-killed-assoc (nreverse new-killed))
  6864.     (setq gnus-killed-hashtb
  6865.       (gnus-make-hashtable-from-alist gnus-killed-assoc))
  6866.     ))
  6867.  
  6868. (defun gnus-check-bogus-newsgroups (&optional confirm)
  6869.   "Delete bogus newsgroups.
  6870. If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
  6871.   (let ((group nil)            ;Newsgroup name temporary used.
  6872.     (old-newsrc gnus-newsrc-assoc)
  6873.     (new-newsrc nil)
  6874.     (bogus nil)            ;List of bogus newsgroups.
  6875.     (old-killed gnus-killed-assoc)
  6876.     (new-killed nil)
  6877.     (old-marked gnus-marked-assoc)
  6878.     (new-marked nil))
  6879.     (message "Checking bogus newsgroups...")
  6880.     ;; Update gnus-newsrc-assoc and gnus-newsrc-hashtb.
  6881.     (while old-newsrc
  6882.       (setq group (car (car old-newsrc)))
  6883.       (if (or (gnus-gethash group gnus-active-hashtb)
  6884.           (and confirm
  6885.            (not (y-or-n-p
  6886.              (format "Delete bogus newsgroup: %s " group)))))
  6887.       ;; Active newsgroup.
  6888.       (setq new-newsrc (cons (car old-newsrc) new-newsrc))
  6889.     ;; Found a bogus newsgroup.
  6890.     (setq bogus (cons group bogus)))
  6891.       (setq old-newsrc (cdr old-newsrc))
  6892.       )
  6893.     (setq gnus-newsrc-assoc (nreverse new-newsrc))
  6894.     (setq gnus-newsrc-hashtb
  6895.       (gnus-make-hashtable-from-alist gnus-newsrc-assoc))
  6896.     ;; Update gnus-killed-assoc and gnus-killed-hashtb.
  6897.     ;; The killed newsgroups are deleted without any confirmations.
  6898.     (while old-killed
  6899.       (setq group (car (car old-killed)))
  6900.       (and (gnus-gethash group gnus-active-hashtb)
  6901.        (null (gnus-gethash group gnus-newsrc-hashtb))
  6902.        ;; Active and really killed newsgroup.
  6903.        (setq new-killed (cons (car old-killed) new-killed)))
  6904.       (setq old-killed (cdr old-killed))
  6905.       )
  6906.     (setq gnus-killed-assoc (nreverse new-killed))
  6907.     (setq gnus-killed-hashtb
  6908.       (gnus-make-hashtable-from-alist gnus-killed-assoc))
  6909.     ;; Remove BOGUS from .newsrc file.
  6910.     (while bogus
  6911.       (gnus-update-newsrc-buffer (car bogus) 'delete)
  6912.       (setq bogus (cdr bogus)))
  6913.     ;; Update gnus-marked-assoc and gnus-marked-hashtb.
  6914.     (while old-marked
  6915.       (setq group (car (car old-marked)))
  6916.       (if (and (cdr (car old-marked))    ;Non-empty?
  6917.            (gnus-gethash group gnus-newsrc-hashtb))    ;Not bogus?
  6918.       (setq new-marked (cons (car old-marked) new-marked)))
  6919.       (setq old-marked (cdr old-marked)))
  6920.     (setq gnus-marked-assoc new-marked)
  6921.     (setq gnus-marked-hashtb
  6922.       (gnus-make-hashtable-from-alist gnus-marked-assoc))
  6923.     (message "Checking bogus newsgroups... done")
  6924.     ))
  6925.  
  6926. (defun gnus-get-unread-articles ()
  6927.   "Compute diffs between active and read articles."
  6928.   (let ((read gnus-newsrc-assoc)
  6929.     (group-info nil)
  6930.     (group-name nil)
  6931.     (active nil)
  6932.     (range nil)
  6933.         ;; XEmacs change
  6934.     (total (length gnus-newsrc-assoc))
  6935.     (count 0))
  6936.     (message "Checking new news...")
  6937.     (or gnus-unread-hashtb
  6938.     (setq gnus-unread-hashtb
  6939.           (gnus-make-hashtable (length gnus-active-hashtb))))
  6940.     (while read
  6941.       ;; XEmacs change
  6942.       (if (= 0 (% count 1000))
  6943.       ;; this is such a tight loop that this actually matters a little
  6944.       (gnus-lazy-message "Checking new news... %d%%" (/ count total)))
  6945.       (setq count (+ count 100))
  6946.  
  6947.       (setq group-info (car read))    ;About one newsgroup
  6948.       (setq group-name (car group-info))
  6949.       (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
  6950.       (if (and gnus-octive-hashtb
  6951.            ;; Is nothing changed?
  6952.            (equal active
  6953.               (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
  6954.            ;; Is this newsgroup in the unread hash table?
  6955.            (gnus-gethash group-name gnus-unread-hashtb)
  6956.            )
  6957.       nil                ;Nothing to do.
  6958.     (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
  6959.     ;; #### we could halve number of interns by saving the symbol from
  6960.     ;; gnus-unread-hashtb.
  6961.     (gnus-sethash group-name
  6962.               (cons group-name    ;Group name
  6963.                 (cons (gnus-number-of-articles range)
  6964.                   range)) ;Range of unread articles
  6965.               gnus-unread-hashtb)
  6966.     )
  6967.       (setq read (cdr read))
  6968.       )
  6969.     (message "Checking new news... done")
  6970.     ))
  6971.  
  6972. (defun gnus-expire-marked-articles ()
  6973.   "Check expired article which is marked as unread."
  6974.   (let ((marked-assoc gnus-marked-assoc)
  6975.     (updated-assoc nil)
  6976.     (marked nil)            ;Current marked info.
  6977.     (articles nil)            ;List of marked articles.
  6978.     (updated nil)            ;List of real marked.
  6979.     (begin nil))
  6980.     (while marked-assoc
  6981.       (setq marked (car marked-assoc))
  6982.       (setq articles (cdr marked))
  6983.       (setq updated nil)
  6984.       (setq begin
  6985.         (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
  6986.       (while (and begin articles)
  6987.     (if (>= (car articles) begin)
  6988.         ;; This article is still active.
  6989.         (setq updated (cons (car articles) updated)))
  6990.     (setq articles (cdr articles)))
  6991.       (if updated
  6992.       (setq updated-assoc
  6993.         (cons (cons (car marked) updated) updated-assoc)))
  6994.       (setq marked-assoc (cdr marked-assoc)))
  6995.     (setq gnus-marked-assoc updated-assoc)
  6996.     (setq gnus-marked-hashtb
  6997.       (gnus-make-hashtable-from-alist gnus-marked-assoc))
  6998.     ))
  6999.  
  7000. (defun gnus-mark-as-read-by-xref
  7001.   (group headers unreads &optional subscribed-only)
  7002.   "Mark articles as read using cross references and return updated newsgroups.
  7003. Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."
  7004.   (let ((xref-list nil)
  7005.     (header nil)
  7006.     (xrefs nil)            ;One Xref: field info.
  7007.     (xref nil)            ;(NEWSGROUP . ARTICLE)
  7008.     (gname nil)            ;Newsgroup name
  7009.     (article nil)            ;Article number
  7010.         ;; XEmacs change
  7011.     total
  7012.     (count 0))
  7013.     (setq total (length headers))
  7014.     (message "Looking for crossposts...")
  7015.     (while headers
  7016.       (setq header (car headers))
  7017.       (gnus-lazy-message "Looking for crossposts... %d%%" (/ count total))
  7018.       (if (memq (nntp-header-number header) unreads)
  7019.       ;; This article is not yet marked as read.
  7020.       nil
  7021.     (setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
  7022.     (if xrefs
  7023.         (gnus-lazy-message "Looking for crossposts... %d%%"
  7024.                    (/ count total)))
  7025.     ;; For each cross reference info. in one Xref: field.
  7026.     (while xrefs
  7027.       (setq xref (car xrefs))
  7028.       (setq gname (car xref))    ;Newsgroup name
  7029.       (setq article (cdr xref))    ;Article number
  7030.       (or (string-equal group gname) ;Ignore current newsgroup.
  7031.           ;; Ignore unsubscribed newsgroup if requested.
  7032.           (and subscribed-only
  7033.            (not (nth 1 (gnus-gethash gname gnus-newsrc-hashtb))))
  7034.           ;; Ignore article marked as unread.
  7035.           (memq article (cdr (gnus-gethash gname gnus-marked-hashtb)))
  7036.           (let ((group-xref (assoc gname xref-list)))
  7037.         (if group-xref
  7038.             (if (memq article (cdr group-xref))
  7039.             nil        ;Alread marked.
  7040.               (setcdr group-xref (cons article (cdr group-xref))))
  7041.           ;; Create new assoc entry for GROUP.
  7042.           (setq xref-list (cons (list gname article) xref-list)))
  7043.         ))
  7044.       (setq xrefs (cdr xrefs))
  7045.       ))
  7046.       (setq count (+ count 100))
  7047.       (setq headers (cdr headers)))
  7048.     ;; Mark cross referenced articles as read.
  7049.     (gnus-mark-xrefed-as-read xref-list)
  7050.     (if xref-list
  7051.     (message "%d crosspost%s marked as read."
  7052.          (length xref-list) (if (= 1 (length xref-list)) "" "s"))
  7053.       (message nil))
  7054.     ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
  7055.     ;; Return list of updated group name.
  7056.     (mapcar (function car) xref-list)
  7057.     ))
  7058.  
  7059. (defun gnus-parse-xref-field (xref-value)
  7060.   "Parse Xref: field value, and return list of `(group . article-id)'."
  7061.   (let ((xref-list nil)
  7062.     (xref-value (or xref-value "")))
  7063.     ;; Remove server host name.
  7064.     (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
  7065.     (setq xref-value (substring xref-value (match-beginning 1)))
  7066.       (setq xref-value nil))
  7067.     ;; Process each xref info.
  7068.     (while xref-value
  7069.       (if (string-match
  7070.        "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
  7071.       (progn
  7072.         (setq xref-list
  7073.           (cons
  7074.            (cons
  7075.             ;; Group name
  7076.             (substring xref-value (match-beginning 1) (match-end 1))
  7077.             ;; Article-ID
  7078.             ;; jwz: this is possibly faster than
  7079.             ;; string-to-int/buffer-substring
  7080.             (car (read-from-string xref-value
  7081.                        (match-beginning 2)
  7082.                        (match-end 2))))
  7083.            xref-list))
  7084.         (setq xref-value (substring xref-value (match-end 2))))
  7085.     (setq xref-value nil)))
  7086.     ;; Return alist.
  7087.     xref-list
  7088.     ))
  7089.  
  7090. (defun gnus-mark-xrefed-as-read (xrefs)
  7091.   "Update unread article information using XREFS alist."
  7092.   (let ((group nil)
  7093.     (idlist nil)
  7094.     (unread nil)
  7095.         ;; XEmacs change
  7096.     (total (length xrefs))
  7097.     (count 0))
  7098.     (while xrefs
  7099.       (setq group (car (car xrefs)))
  7100.       (setq idlist (cdr (car xrefs)))
  7101.       (gnus-lazy-message "Marking crossposts... %d%%" (/ count total))
  7102.       (setq count (+ count 100))
  7103.       (setq unread (gnus-uncompress-sequence
  7104.             (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
  7105.       (while idlist
  7106.     (setq unread (delq (car idlist) unread))
  7107.     (setq idlist (cdr idlist)))
  7108.       (gnus-update-unread-articles group unread 'ignore)
  7109.       (setq xrefs (cdr xrefs))
  7110.       )))
  7111.  
  7112. (defun gnus-update-unread-articles (group unread-list marked-list)
  7113.   "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
  7114.   (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
  7115.     (unread (gnus-gethash group gnus-unread-hashtb)))
  7116.     (if (or (null active) (null unread))
  7117.     ;; Ignore unknown newsgroup.
  7118.     nil
  7119.       ;; Update gnus-unread-hashtb.
  7120.       (if unread-list
  7121.       (setcdr (cdr unread)
  7122.           (gnus-compress-sequence unread-list))
  7123.     ;; All of the articles are read.
  7124.     (setcdr (cdr unread) '((0 . 0))))
  7125.       ;; Number of unread articles.
  7126.       (setcar (cdr unread)
  7127.           (gnus-number-of-articles (nthcdr 2 unread)))
  7128.       ;; Update gnus-newsrc-assoc.
  7129.       (if (> (car active) 0)
  7130.       ;; Articles from 1 to N are not active.
  7131.       (setq active (cons 1 (cdr active))))
  7132.       (setcdr (cdr (gnus-gethash group gnus-newsrc-hashtb))
  7133.           (gnus-difference-of-range active (nthcdr 2 unread)))
  7134.       ;; Update .newsrc buffer.
  7135.       (gnus-update-newsrc-buffer group)
  7136.       ;; Update gnus-marked-assoc.
  7137.       (if (listp marked-list)        ;Includes NIL.
  7138.       (let ((marked (gnus-gethash group gnus-marked-hashtb)))
  7139.         (cond (marked        ;There is an entry.
  7140.            (setcdr marked marked-list))
  7141.           (marked-list        ;Non-NIL.
  7142.            (let ((info (cons group marked-list)))
  7143.              ;; hashtb must share the same cons cell.
  7144.              (setq gnus-marked-assoc
  7145.                (cons info gnus-marked-assoc))
  7146.              (gnus-sethash group info gnus-marked-hashtb)
  7147.              ))
  7148.           )))
  7149.       )))
  7150.  
  7151. (defun gnus-read-active-file ()
  7152.   "Get active file from NNTP server."
  7153.   ;; Make sure a connection to NNTP server is alive.
  7154.   (gnus-start-news-server)
  7155.   (message "Reading active file...")
  7156.   (if (gnus-request-list)        ;Get active file from server
  7157.       (save-excursion
  7158.     (set-buffer nntp-server-buffer)
  7159.     (gnus-active-to-gnus-format)
  7160.     (message "Reading active file... done"))
  7161.     (error "Cannot read active file from NNTP server.")))
  7162.  
  7163. ;; rewritten by jwz based on ideas from Rick Sladkey <jrs@world.std.com>
  7164. (defun gnus-active-to-gnus-format ()
  7165.   "Convert active file format to internal format.
  7166. Lines matching gnus-ignored-newsgroups are ignored."
  7167.   ;; Delete unnecessary lines.
  7168.   (goto-char (point-min))
  7169.   ;;(delete-matching-lines "^to\\..*$")
  7170.   (delete-matching-lines gnus-ignored-newsgroups)
  7171.   ;; Save OLD active info.
  7172.   (setq gnus-octive-hashtb gnus-active-hashtb)
  7173.   ;; Make large enough hash table.
  7174.   (setq gnus-active-hashtb
  7175.     (gnus-make-hashtable (count-lines (point-min) (point-max))))
  7176.   ;; Store active file in hashtable.
  7177.   (save-restriction
  7178.     (goto-char (point-min))
  7179.     (if (re-search-forward "\n.\r?$" nil t)
  7180.     (progn
  7181.       (beginning-of-line)
  7182.       (narrow-to-region (point-min) (point))))
  7183.     (goto-char (point-min))
  7184.     (let ((tick 0)
  7185.       group min max type)
  7186.       (while (not (eobp))
  7187.  
  7188.     ;;(setq p (point))
  7189.     ;;(skip-chars-forward "^ \t")
  7190.     ;;(setq group (buffer-substring p (point)))
  7191.  
  7192.     ;; group gets set to a symbol interned in gnus-active-hashtb
  7193.     ;; (what a hack!!)
  7194.     (setq group (let ((obarray gnus-active-hashtb))
  7195.               (read (current-buffer))))
  7196.     (skip-chars-forward " ")
  7197.  
  7198.     (setq min (read (current-buffer)))
  7199.     (setq max (read (current-buffer)))
  7200.     ;;(or (numberp min) (error "lost"))
  7201.     ;;(or (numberp max) (error "lost"))
  7202.     (skip-chars-forward " \t")
  7203.     (setq type (following-char))
  7204.  
  7205.     ;; Danger: intimate knowledge of what gnus-sethash does
  7206.     (set group (list (symbol-name group) (= type ?y) (cons max min)))
  7207.     ;;(gnus-sethash group
  7208.     ;;          (list group (= type ?y) (cons max min))
  7209.     ;;          gnus-active-hashtb)
  7210.  
  7211.     (forward-line 1)
  7212.     (cond ((= 400 (setq tick (1+ tick)))
  7213.            ;; this is such a tight loop that this actually matters a little
  7214.            (gnus-lazy-message "Reading active file...%s%%"
  7215.                   ;; XEmacs fix: avoid overflow
  7216.                   (/ (point) (/ (point-max) 100)))
  7217.            (setq tick 0)))
  7218.     ))))
  7219.  
  7220. (defun gnus-read-newsrc-file (&optional rawfile)
  7221.   "Read startup FILE.
  7222. If optional argument RAWFILE is non-nil, the raw startup file is read."
  7223.   (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
  7224.   ;; Reset variables which may be included in the quick startup file.
  7225.   (let ((variables gnus-variable-list))
  7226.     (while variables
  7227.       (set (car variables) nil)
  7228.       (setq variables (cdr variables))))
  7229.   (let* ((newsrc-file gnus-current-startup-file)
  7230.      (quick-file (concat newsrc-file ".el"))
  7231.      (quick-loaded nil))
  7232.     (save-excursion
  7233.       ;; Prepare .newsrc buffer.
  7234.       (set-buffer (find-file-noselect newsrc-file))
  7235.       ;; It is not so good idea turning off undo.
  7236.       ;;(buffer-disable-undo (current-buffer))
  7237.       ;; Load quick .newsrc to restore gnus-marked-assoc and
  7238.       ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date.
  7239.       (condition-case nil
  7240.       (progn
  7241.         (setq quick-loaded (load quick-file t t t))
  7242.         ;; Recreate hashtables.
  7243.         (setq gnus-killed-hashtb
  7244.           (gnus-make-hashtable-from-alist gnus-killed-assoc))
  7245.         (setq gnus-marked-hashtb
  7246.           (gnus-make-hashtable-from-alist gnus-marked-assoc))
  7247.         )
  7248.     (error nil))
  7249.       (cond ((and (not rawfile)        ;Not forced to read the raw file.
  7250.           ;; .newsrc.el is newer than .newsrc.
  7251.           ;; Do it this way in case timestamps are identical
  7252.           ;; (on fast machines/disks).
  7253.           (not (file-newer-than-file-p newsrc-file quick-file))
  7254.           quick-loaded
  7255.           gnus-newsrc-assoc    ;Really loaded?
  7256.           )
  7257.          ;; We don't have to read the raw startup file.
  7258.          ;; gnus-newsrc-assoc may be defined in the quick startup file.
  7259.          ;; So, we have to define the hashtable here.
  7260.          (setq gnus-newsrc-hashtb
  7261.            (gnus-make-hashtable-from-alist gnus-newsrc-assoc)))
  7262.         (t
  7263.          ;; Since .newsrc file is newer than quick file, read it.
  7264.          (message "Reading %s..." newsrc-file)
  7265.          (gnus-newsrc-to-gnus-format)
  7266.          (gnus-check-killed-newsgroups)
  7267.          (message "Reading %s... Done" newsrc-file)))
  7268.       )))
  7269.  
  7270. (defun gnus-make-newsrc-file (file)
  7271.   "Make server dependent file name by catenating FILE and server host name."
  7272.   (let* ((file (expand-file-name file nil))
  7273.      (real-file (concat file "-" gnus-nntp-server)))
  7274.     (if (file-exists-p real-file)
  7275.     real-file file)
  7276.     ))
  7277.  
  7278.  
  7279. ;; jwz: rewrote this function to be much more efficient, and not be subject
  7280. ;; to regexp overflow errors when it encounters very long lines -- the old
  7281. ;; behavior was to blow off the rest of the *file* when a line was encountered
  7282. ;; that was too long to match!!  Now it uses only simple looking-at calls, and
  7283. ;; doesn't create as many temporary strings.  It also now handles multiple
  7284. ;; consecutive options lines (before it only handled the first.)
  7285.  
  7286. (defun gnus-newsrc-to-gnus-format ()
  7287.   "Parse current buffer as .newsrc file."
  7288.   ;; We have to re-initialize these variables (except for
  7289.   ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup
  7290.   ;; file may contain bogus values.
  7291.   (setq gnus-newsrc-options nil)
  7292.   (setq gnus-newsrc-options-n-yes nil)
  7293.   (setq gnus-newsrc-options-n-no nil)
  7294.   (setq gnus-newsrc-assoc nil)
  7295.   ;; Make large enough hash table.
  7296.   (setq gnus-newsrc-hashtb
  7297.     (gnus-make-hashtable
  7298.      (max (length gnus-active-hashtb)
  7299.           (count-lines (point-min) (point-max)))))
  7300.   
  7301.   (gnus-parse-options-lines)
  7302.   (gnus-parse-newsrc-body)
  7303.   )
  7304.  
  7305. (defun gnus-parse-options-lines ()
  7306.   ;; newsrc.5 seems to indicate that the options line can come anywhere
  7307.   ;; in the file, and that there can be any number of them:
  7308.   ;;
  7309.   ;;       An  options  line  starts  with  the  word  options (left-
  7310.   ;;       justified).  Then there are the list of  options  just  as
  7311.   ;;       they would be on the readnews command line.  For instance:
  7312.   ;;
  7313.   ;;       options -n all !net.sf-lovers !mod.human-nets -r
  7314.   ;;       options -c -r
  7315.   ;;
  7316.   ;;       A string of lines beginning with a space or tab after  the
  7317.   ;;       initial  options  line  will  be  considered  continuation
  7318.   ;;       lines.
  7319.   ;;
  7320.   ;; This makes parsing a pain.  So, the first thing we do is search
  7321.   ;; through the file for all options lines and move them to the front
  7322.   ;; of the buffer where they belong.  Then, when parsing, we can assume
  7323.   ;; that they're all at the front.
  7324.   ;;
  7325.   ;; I believe the newsgroup kill/yank code will sometimes put newsgroups
  7326.   ;; before the options lines, so this actually is necessary...
  7327.   ;;
  7328.   (goto-char (point-min))
  7329.   (if (looking-at "[ \t\n]+")
  7330.       (delete-region (match-beginning 0) (match-end 0)))
  7331.   (let ((output (point-marker))
  7332.     (changed nil)
  7333.     s e l)
  7334.     (while (search-forward "\noptions" nil t)
  7335.       (setq changed t)
  7336.       (setq s (1+ (match-beginning 0)))
  7337.       (forward-line 1)
  7338.       (setq e (point))
  7339.       (setq l (buffer-substring s e))
  7340.       (delete-region s e)
  7341.       (forward-char -1)
  7342.       (princ l output))
  7343.     (set-marker output nil)
  7344.     (if changed
  7345.     (message (format "fixed up options lines in %s"
  7346.              (file-name-nondirectory
  7347.               (or (buffer-file-name) ".newsrc"))))))
  7348.  
  7349.   (goto-char (point-min))
  7350.   (skip-chars-forward " \t\n")
  7351.   (setq gnus-newsrc-options nil)
  7352.   (while (looking-at "^options[ \t]*\\(.*\\)\n")
  7353.     ;; handle consecutive options lines
  7354.     (setq gnus-newsrc-options (concat gnus-newsrc-options
  7355.                       (if gnus-newsrc-options "\n\t")
  7356.                       (buffer-substring (match-beginning 1)
  7357.                             (match-end 1))))
  7358.     (forward-line 1)
  7359.     (while (looking-at "[ \t]+\\(.*\\)\n")
  7360.       ;; handle subsequent continuation lines of this options line
  7361.       (setq gnus-newsrc-options (concat gnus-newsrc-options "\n\t"
  7362.                     (buffer-substring (match-beginning 1)
  7363.                               (match-end 1))))
  7364.       (forward-line 1)))
  7365.   ;; Gather all "-n" options lines.
  7366.   (let ((start 0)
  7367.     (result nil))
  7368.     (if gnus-newsrc-options
  7369.     (while (and (string-match "^[ \t]*-n\\([^\n]*\\)$"
  7370.                   gnus-newsrc-options
  7371.                   start)
  7372.             (setq start (match-end 0)))
  7373.       (setq result (concat result
  7374.                    (and result " ")
  7375.                    (substring gnus-newsrc-options
  7376.                       (match-beginning 1)
  7377.                       (match-end 1))))))
  7378.     (let ((yes-and-no (and result (gnus-parse-n-options result))))
  7379.       (setq gnus-newsrc-options-n-yes (car yes-and-no))
  7380.       (setq gnus-newsrc-options-n-no  (cdr yes-and-no)))
  7381.     nil))
  7382.  
  7383. (defun gnus-parse-newsrc-body ()
  7384.   ;; Point has been positioned after the options lines.  We shouldn't
  7385.   ;; see any more in here.
  7386.  
  7387.   (let ((subscribe nil)
  7388.     (read-list nil)
  7389.     (line (1+ (count-lines (point-min) (point))))
  7390.     newsgroup
  7391.     p p2)
  7392.     (save-restriction
  7393.       (skip-chars-forward " \t")
  7394.       (while (not (eobp))
  7395.     (cond
  7396.      ((= (following-char) ?\n)
  7397.       ;; skip blank lines
  7398.       nil)
  7399.      (t
  7400.       (setq p (point))
  7401.       (skip-chars-forward "^:!\n")
  7402.       (if (= (following-char) ?\n)
  7403.           (error "line %d is unparsable in %s" line (buffer-name)))
  7404.       (setq p2 (point))
  7405.       (skip-chars-backward " \t")
  7406.  
  7407.       ;; #### note: we could avoid consing a string here by binding obarray
  7408.       ;; and reading the newsgroup directly into the gnus-newsrc-hashtb,
  7409.       ;; then setq'ing newsgroup to symbol-name of that, like we do in
  7410.       ;; gnus-active-to-gnus-format.
  7411.       (setq newsgroup (buffer-substring p (point)))
  7412.       (goto-char p2)
  7413.  
  7414.       ;; Check duplications of newsgroups.
  7415.       ;; Note: Checking the duplications takes very long time.
  7416.       (if (gnus-gethash newsgroup gnus-newsrc-hashtb)
  7417.           (message "Ignoring duplicated newsgroup: %s on line %d"
  7418.                newsgroup line))
  7419.  
  7420.       (setq subscribe (= (following-char) ?:))
  7421.       (setq read-list nil)
  7422.  
  7423.       (forward-char 1)        ; after : or !
  7424.       (skip-chars-forward " \t")
  7425.       (while (not (= (following-char) ?\n))
  7426.         (skip-chars-forward " \t")
  7427.         (or
  7428.          (and (cond
  7429.            ((looking-at "\\([0-9]+\\)-\\([0-9]+\\)") ; a range
  7430.             (setq read-list
  7431.               (cons
  7432.                (cons
  7433.                 (progn
  7434.                   ;; faster that buffer-substring/string-to-int
  7435.                   (narrow-to-region (point-min) (match-end 1))
  7436.                   (read (current-buffer)))
  7437.                 (progn
  7438.                   (narrow-to-region (point-min) (match-end 2))
  7439.                   (forward-char) ; skip over "-"
  7440.                   (prog1
  7441.                   (read (current-buffer))
  7442.                 (widen))))
  7443.                read-list))
  7444.             t)
  7445.            ((looking-at "[0-9]+")
  7446.             ;; faster that buffer-substring/string-to-int
  7447.             (narrow-to-region (point-min) (match-end 0))
  7448.             (setq p (read (current-buffer)))
  7449.             (widen)
  7450.             (setq read-list (cons (cons p p) read-list))
  7451.             t)
  7452.            (t
  7453.             ;; bogus chars in ranges
  7454.             nil))
  7455.           (progn
  7456.             (goto-char (match-end 0))
  7457.             (skip-chars-forward " \t")
  7458.             (cond ((= (following-char) ?,)
  7459.                (forward-char 1)
  7460.                t)
  7461.               ((= (following-char) ?\n)
  7462.                t)
  7463.               (t
  7464.                ;; bogus char after range
  7465.                nil))))
  7466.          ;; if we get here, the parse failed
  7467.          (progn
  7468.            (end-of-line)        ; give up on this line
  7469.            (ding)
  7470.            (message "Ignoring bogus line %d for %s in %s"
  7471.             line newsgroup (buffer-name))
  7472.            (sleep-for 1)
  7473.            )))
  7474.       (setq gnus-newsrc-assoc
  7475.         (cons (cons newsgroup (cons subscribe (nreverse read-list)))
  7476.               gnus-newsrc-assoc))
  7477.       ;; Update gnus-newsrc-hashtb one by one.
  7478.       (gnus-sethash newsgroup (car gnus-newsrc-assoc) gnus-newsrc-hashtb)
  7479.       ))
  7480.     (setq line (1+ line))
  7481.     (forward-line 1))))
  7482.   (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
  7483.   nil)
  7484.  
  7485. (defun gnus-parse-n-options (options)
  7486.   "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
  7487.   (let ((yes nil)
  7488.     (no nil)
  7489.     (yes-or-no nil)            ;`!' or not.
  7490.     (newsgroup nil))
  7491.     ;; Parse each newsgroup description such as "comp.all".  Commas
  7492.     ;; and white spaces can be a newsgroup separator.
  7493.     (while
  7494.     (string-match "^[ \t\n,]*\\(!?\\)\\([^--- \t\n,][^ \t\n,]*\\)" options)
  7495.       (setq yes-or-no
  7496.         (substring options (match-beginning 1) (match-end 1)))
  7497.       (setq newsgroup
  7498.         (regexp-quote
  7499.          (substring options
  7500.             (match-beginning 2) (match-end 2))))
  7501.       (setq options (substring options (match-end 2)))
  7502.       ;; Rewrite "all" to ".+" not ".*".  ".+" requires at least one
  7503.       ;; character.
  7504.       (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
  7505.     (setq newsgroup
  7506.           (concat (substring newsgroup 0 (match-end 1))
  7507.               ".+"
  7508.               (substring newsgroup (match-beginning 2)))))
  7509.       ;; It is yes or no.
  7510.       (cond ((string-equal yes-or-no "!")
  7511.          (setq no (cons newsgroup no)))
  7512.         ((string-equal newsgroup ".+")) ;Ignore `all'.
  7513.         (t
  7514.          (setq yes (cons newsgroup yes))))
  7515.       )
  7516.     ;; Make a cons of regexps from parsing result.
  7517.     ;; We have to append \(\.\|$\) to prevent matching substring of
  7518.     ;; newsgroup.  For example, "jp.net" should not match with
  7519.     ;; "jp.network".
  7520.     ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp.
  7521.     (cons (if yes
  7522.           (concat "^\\("
  7523.               (apply (function concat)
  7524.                  (mapcar
  7525.                   (function
  7526.                    (lambda (newsgroup)
  7527.                  (concat newsgroup "\\|")))
  7528.                   (cdr yes)))
  7529.               (car yes) "\\)\\(\\.\\|$\\)"))
  7530.       (if no
  7531.           (concat "^\\("
  7532.               (apply (function concat)
  7533.                  (mapcar
  7534.                   (function
  7535.                    (lambda (newsgroup)
  7536.                  (concat newsgroup "\\|")))
  7537.                   (cdr no)))
  7538.               (car no) "\\)\\(\\.\\|$\\)")))
  7539.     ))
  7540.  
  7541. (defun gnus-save-newsrc-file ()
  7542.   "Save to .newsrc FILE."
  7543.   ;; Note: We cannot save .newsrc file if all newsgroups are removed
  7544.   ;; from the variable gnus-newsrc-assoc.
  7545.   (and (or gnus-newsrc-assoc gnus-killed-assoc)
  7546.        gnus-current-startup-file
  7547.        (save-excursion
  7548.      ;; A buffer containing .newsrc file may be deleted.
  7549.      (set-buffer (find-file-noselect gnus-current-startup-file))
  7550.      (if (not (buffer-modified-p))
  7551.          (message "(No changes need to be saved)")
  7552.        (message "Saving %s..." gnus-current-startup-file)
  7553.        (let ((make-backup-files t)
  7554.          (version-control nil)
  7555.          (require-final-newline t)) ;Don't ask even if requested.
  7556.          ;; Make backup file of master newsrc.
  7557.          ;; You can stop or change version control of backup file.
  7558.          ;; Suggested by jason@violet.berkeley.edu.
  7559.          (run-hooks 'gnus-save-newsrc-hook)
  7560.          (save-buffer))
  7561.        ;; Quickly loadable .newsrc.
  7562.        (set-buffer (get-buffer-create " *GNUS-newsrc*"))
  7563.        (buffer-disable-undo (current-buffer))
  7564.        (erase-buffer)
  7565.        (gnus-gnus-to-quick-newsrc-format)
  7566.        (let ((make-backup-files nil)
  7567.          (version-control nil)
  7568.          (require-final-newline t)) ;Don't ask even if requested.
  7569.          (write-file (concat gnus-current-startup-file ".el")))
  7570.        (kill-buffer (current-buffer))
  7571.        (message "Saving %s... Done" gnus-current-startup-file)
  7572.        ))
  7573.     ))
  7574.  
  7575. ;; XEmacs change: from flee@cse.psu.edu
  7576.  
  7577. ;;;; A fast group search in the newsrc buffer.
  7578.  
  7579. ;;; Simple linear search is fine for this.
  7580.  
  7581. ;;; Timings on a Sun 4/20, Emacs 19.19, built with gcc-2.4.5 -O2
  7582. ;;; newsrc with 2052 lines, 71871 chars
  7583. ;;; find "za.unix.misc:" on line 2050, char 71837:
  7584. ;;;   0.009s
  7585. ;;; find "vmsnet.databases.rdb!" on line 2043, char 71661:
  7586. ;;;   0.010s
  7587.  
  7588. (defun gnus-newsrc-first-group-is (group)
  7589.   (save-excursion
  7590.     (goto-char (1+ (length group)))
  7591.     (and (or (eq (following-char) ?:)
  7592.          (eq (following-char) ?!))
  7593.      (string= (buffer-substring (point-min) (point)) group))))
  7594.  
  7595. ;; XEmacs change: from flee@cse.psu.edu
  7596. (defun gnus-newsrc-find-group (group)
  7597.   "Sets point to the beginning of the newsrc line for GROUP.  
  7598. Returns nil if not found."
  7599.   (goto-char (point-min))
  7600.   (if (or (gnus-newsrc-first-group-is group)
  7601.       (search-forward (concat "\n" group ":") nil t)
  7602.       (search-forward (concat "\n" group "!") nil t))
  7603.       (progn (beginning-of-line) t)))
  7604.  
  7605. ;; XEmacs change: faster version from flee@cse.psu.edu
  7606. (defun gnus-update-newsrc-buffer (group &optional delete next)
  7607.   "Incrementally update .newsrc buffer about GROUP.
  7608. If optional 1st argument DELETE is non-nil, delete the group.
  7609. If optional 2nd argument NEXT is non-nil, inserted before it."
  7610.   (save-excursion
  7611.     ;; Taking account of the killed startup file.
  7612.     ;; Suggested by tale@pawl.rpi.edu.
  7613.     (set-buffer (or (get-file-buffer gnus-current-startup-file)
  7614.             (find-file-noselect gnus-current-startup-file)))
  7615.     (let ((buffer-read-only nil)
  7616.       (info nil))
  7617.       ;; Delete the old line.
  7618.       (if (gnus-newsrc-find-group group)
  7619.       (delete-region (point) (progn (forward-line 1) (point))))
  7620.       (if delete
  7621.       nil
  7622.     ;; Go to the right place.
  7623.     (if next
  7624.         (gnus-newsrc-find-group next))
  7625.     ;; Insert group entry.
  7626.     (setq info (gnus-gethash group gnus-newsrc-hashtb))
  7627.     (if (null info)
  7628.         nil
  7629.       (insert group                ; Group name
  7630.           (if (nth 1 info) ": " "! "))    ; Subscribed?
  7631.       (gnus-ranges-to-newsrc-format (nthcdr 2 info)) ;Read articles
  7632.       (insert "\n")
  7633.       )))))
  7634.  
  7635. (defun gnus-gnus-to-quick-newsrc-format ()
  7636.   "Insert GNUS variables such as gnus-newsrc-assoc in lisp format."
  7637.   (insert ";; GNUS internal format of .newsrc.\n")
  7638.   (insert ";; Touch .newsrc instead if you think to remove this file.\n")
  7639.   (let ((variable nil)
  7640.     (variables gnus-variable-list)
  7641.     ;; Temporary rebind to make changes
  7642.     ;; gnus-check-killed-newsgroups in invisible.
  7643.     (gnus-killed-assoc gnus-killed-assoc)
  7644.     (gnus-killed-hashtb gnus-killed-hashtb))
  7645.     ;; Remove duplicated or unsubscribed newsgroups in
  7646.     ;; gnus-killed-assoc (and gnus-killed-hashtb).
  7647.     (gnus-check-killed-newsgroups)
  7648.     ;; Then, insert lisp expressions.
  7649.     (while variables
  7650.       (setq variable (car variables))
  7651.       (and (boundp variable)
  7652.        (symbol-value variable)
  7653.        (insert "(setq " (symbol-name variable) " '"
  7654.            (prin1-to-string (symbol-value variable))
  7655.            ")\n"))
  7656.       (setq variables (cdr variables)))
  7657.     ))
  7658.  
  7659. (defun gnus-ranges-to-newsrc-format (ranges)
  7660.   "Insert ranges of read articles."
  7661.   (let ((range nil))            ;Range is a pair of BEGIN and END.
  7662.     (while ranges
  7663.       (setq range (car ranges))
  7664.       (setq ranges (cdr ranges))
  7665.       (cond ((= (car range) (cdr range))
  7666.          (if (= (car range) 0)
  7667.          (setq ranges nil)    ;No unread articles.
  7668.            (insert (int-to-string (car range)))
  7669.            (if ranges (insert ","))
  7670.            ))
  7671.         (t
  7672.          (insert (int-to-string (car range))
  7673.              "-"
  7674.              (int-to-string (cdr range)))
  7675.          (if ranges (insert ","))
  7676.          ))
  7677.       )))
  7678.  
  7679. (defun gnus-compress-sequence (numbers)
  7680.   "Convert list of sorted numbers to ranges."
  7681.   (let* ((numbers (sort (copy-sequence numbers) (function <)))
  7682.      (first (car numbers))
  7683.      (last (car numbers))
  7684.      (result nil))
  7685.     (while numbers
  7686.       (cond ((= last (car numbers)) nil) ;Omit duplicated number
  7687.         ((= (1+ last) (car numbers)) ;Still in sequence
  7688.          (setq last (car numbers)))
  7689.         (t                ;End of one sequence
  7690.          (setq result (cons (cons first last) result))
  7691.          (setq first (car numbers))
  7692.          (setq last  (car numbers)))
  7693.         )
  7694.       (setq numbers (cdr numbers))
  7695.       )
  7696.     (nreverse (cons (cons first last) result))
  7697.     ))
  7698.  
  7699. (defun gnus-uncompress-sequence (ranges)
  7700.   "Expand compressed format of sequence."
  7701.   (let ((first nil)
  7702.     (last  nil)
  7703.     (result nil))
  7704.     (while ranges
  7705.       (setq first (car (car ranges)))
  7706.       (setq last  (cdr (car ranges)))
  7707.       (while (< first last)
  7708.     (setq result (cons first result))
  7709.     (setq first (1+ first)))
  7710.       (setq result (cons first result))
  7711.       (setq ranges (cdr ranges))
  7712.       )
  7713.     (nreverse result)
  7714.     ))
  7715.  
  7716. (defun gnus-number-of-articles (range)
  7717.   "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
  7718.   (let ((count 0))
  7719.     (while range
  7720.       (if (/= (cdr (car range)) 0)
  7721.       ;; If end1 is 0, it must be skipped. Usually no articles in
  7722.       ;;  this group.
  7723.       (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
  7724.       (setq range (cdr range))
  7725.       )
  7726.     count                ;Result
  7727.     ))
  7728.  
  7729. (defun gnus-difference-of-range (src obj)
  7730.   "Compute (SRC - OBJ) on range.
  7731. Range of SRC is expressed as `(beg . end)'.
  7732. Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
  7733.   (let ((beg (car src))
  7734.     (end (cdr src))
  7735.     (range nil))            ;This is result.
  7736.     ;; Src may be nil.
  7737.     (while (and src obj)
  7738.       (let ((beg1 (car (car obj)))
  7739.         (end1 (cdr (car obj))))
  7740.     (cond ((> beg end)
  7741.            (setq obj nil))        ;Terminate loop
  7742.           ((< beg beg1)
  7743.            (setq range (cons (cons beg (min (1- beg1) end)) range))
  7744.            (setq beg (1+ end1)))
  7745.           ((>= beg beg1)
  7746.            (setq beg (max beg (1+ end1))))
  7747.           )
  7748.     (setq obj (cdr obj))        ;Next OBJ
  7749.     ))
  7750.     ;; Src may be nil.
  7751.     (if (and src (<= beg end))
  7752.     (setq range (cons (cons beg end) range)))
  7753.     ;; Result
  7754.     (if range
  7755.     (nreverse range)
  7756.       (list (cons 0 0)))
  7757.     ))
  7758.  
  7759. (defun gnus-read-distributions-file ()
  7760.   "Get distributions file from NNTP server (NNTP2 functionality)."
  7761.   ;; Make sure a connection to NNTP server is alive.
  7762.   (gnus-start-news-server)
  7763.   (message "Reading distributions file...")
  7764.   (setq gnus-distribution-list nil)
  7765.   (if (gnus-request-list-distributions)
  7766.       (save-excursion
  7767.     (set-buffer nntp-server-buffer)
  7768.     (gnus-distributions-to-gnus-format)
  7769.     (message "Reading distributions file... done"))
  7770.     ;; It's not a fatal error.
  7771.     ;;(error "Cannot read distributions file from NNTP server.")
  7772.     )
  7773.   ;; Merge with user supplied default distributions.
  7774.   (let ((defaults (reverse gnus-local-distributions))
  7775.     (dist nil))
  7776.     (while defaults
  7777.       (setq dist (assoc (car defaults) gnus-distribution-list))
  7778.       (if dist
  7779.       (setq gnus-distribution-list
  7780.         (delq dist gnus-distribution-list)))
  7781.       (setq gnus-distribution-list
  7782.         (cons (list (car defaults)) gnus-distribution-list))
  7783.       (setq defaults (cdr defaults))
  7784.       )))
  7785.  
  7786. (defun gnus-distributions-to-gnus-format ()
  7787.   "Convert distributions file format to internal format."
  7788.   (setq gnus-distribution-list nil)
  7789.   (goto-char (point-min))
  7790.   (while (re-search-forward "^\\([^ \t\n]+\\).*$" nil t)
  7791.     (setq gnus-distribution-list
  7792.       (cons (list (buffer-substring (match-beginning 1) (match-end 1)))
  7793.         gnus-distribution-list)))
  7794.   (setq gnus-distribution-list
  7795.     (nreverse gnus-distribution-list)))
  7796.  
  7797. ;; Some older version of GNU Emacs does not support function
  7798. ;; `file-newer-than-file-p'.
  7799.  
  7800. (or (fboundp 'file-newer-than-file-p)
  7801.     (defun file-newer-than-file-p (file1 file2)
  7802.       "Return t if file FILE1 is newer than file FILE2.
  7803. If FILE1 does not exist, the answer is nil;
  7804. otherwise, if FILE2 does not exist, the answer is t."
  7805.       (let ((mod1 (nth 5 (file-attributes file1)))
  7806.         (mod2 (nth 5 (file-attributes file2))))
  7807.     (cond ((not (file-exists-p file1)) nil)
  7808.           ((not (file-exists-p file2)) t)
  7809.           ((and mod2 mod1)
  7810.            (or (< (car mod2) (car mod1))
  7811.            (and (= (car mod2) (car mod1))
  7812.             (<= (nth 1 mod2) (nth 1 mod1)))))
  7813.           ))))
  7814.  
  7815.  
  7816. (make-obsolete-variable 'gnus-auto-center-subject   'gnus-auto-center-summary)
  7817. (make-obsolete-variable 'gnus-Group-mode-hook        'gnus-group-mode-hook)
  7818. (make-obsolete-variable 'gnus-Subject-mode-hook        'gnus-summary-mode-hook)
  7819. (make-obsolete-variable 'gnus-Article-mode-hook        'gnus-article-mode-hook)
  7820. (make-obsolete-variable 'gnus-Kill-file-mode-hook   'gnus-kill-file-mode-hook)
  7821. (make-obsolete-variable 'gnus-Open-server-hook        'gnus-open-server-hook)
  7822. (make-obsolete-variable 'gnus-Startup-hook        'gnus-startup-hook)
  7823. (make-obsolete-variable 'gnus-Group-prepare-hook    'gnus-group-prepare-hook)
  7824. (make-obsolete-variable 'gnus-Subject-prepare-hook  'gnus-summary-prepare-hook)
  7825. (make-obsolete-variable 'gnus-Article-prepare-hook  'gnus-article-prepare-hook)
  7826. (make-obsolete-variable 'gnus-Select-group-hook        'gnus-select-group-hook)
  7827. (make-obsolete-variable 'gnus-Select-article-hook   'gnus-select-article-hook)
  7828. (make-obsolete-variable 'gnus-Select-digest-hook    'gnus-select-digest-hook)
  7829. (make-obsolete-variable 'gnus-Rmail-digest-hook        'gnus-rmail-digest-hook)
  7830. (make-obsolete-variable 'gnus-Apply-kill-hook        'gnus-apply-kill-hook)
  7831. (make-obsolete-variable 'gnus-Mark-article-hook        'gnus-mark-article-hook)
  7832. (make-obsolete-variable 'gnus-Inews-article-hook    'gnus-inews-article-hook)
  7833. (make-obsolete-variable 'gnus-Exit-group-hook        'gnus-exit-group-hook)
  7834. (make-obsolete-variable 'gnus-Suspend-gnus-hook        'gnus-suspend-gnus-hook)
  7835. (make-obsolete-variable 'gnus-Exit-gnus-hook        'gnus-exit-gnus-hook)
  7836. (make-obsolete-variable 'gnus-Save-newsrc-hook        'gnus-save-newsrc-hook)
  7837. (make-obsolete-variable 'gnus-Info-nodes        'gnus-info-nodes)
  7838. (make-obsolete-variable 'gnus-Group-buffer        'gnus-group-buffer)
  7839. (make-obsolete-variable 'gnus-Subject-buffer        'gnus-summary-buffer)
  7840. (make-obsolete-variable 'gnus-Article-buffer        'gnus-article-buffer)
  7841. (make-obsolete-variable 'gnus-Digest-buffer        'gnus-digest-buffer)
  7842. (make-obsolete-variable 'gnus-Digest-summary-buffer
  7843.             'gnus-digest-summary-buffer)
  7844. (make-obsolete-variable 'gnus-Group-mode-map        'gnus-group-mode-map)
  7845. (make-obsolete-variable 'gnus-Subject-mode-map        'gnus-summary-mode-map)
  7846. (make-obsolete-variable 'gnus-Article-mode-map        'gnus-article-mode-map)
  7847. (make-obsolete-variable 'gnus-Kill-file-mode-map    'gnus-kill-file-mode-map)
  7848. (make-obsolete-variable 'gnus-Subject-menu        'gnus-summary-menu)
  7849. (make-obsolete-variable 'gnus-Group-menu        'gnus-group-menu)
  7850. (make-obsolete-variable 'gnus-Article-menu        'gnus-article-menu)
  7851. (make-obsolete-variable 'gnus-Browse-killed-buffer  'gnus-browse-killed-buffer)
  7852. (make-obsolete-variable 'gnus-Browse-killed-mode-hook
  7853.             'gnus-browse-killed-mode-hook)
  7854. (make-obsolete-variable 'gnus-Browse-killed-mode-map
  7855.             'gnus-browse-killed-mode-map)
  7856.  
  7857. ;;; gnus.el ends here
  7858.